Hollywood Poker source code (Amiga)
unknown
assembly_x86
2 years ago
43 kB
39
Indexable
; *************************************************************
; * *
; * reLINE Cross Development product - West Germany 1987 *
; * *
;* \\\\\ H O L L Y W O O D - P O K E R ///// *
;* \\\\\ transposed from Atari ST ///// *
; * ///// \\\\\ *
; * ///// a creation of Holger Gehrmann \\\\\ *
; * *
; *************************************************************
run: jmp begin
base =run+$4000
holldat =base
stack =base+$8f00
decomem =$5c000
girldata=$70000
screen =$70000
picmem =$7c000
picmend =picmem+$4000
caoff =$8700 ;kartenoffset
wimoff =80*25
chranf =8*1280
melf =32*80+2
umelf =56*80+1
betoff =80*4+melf+caoff+52
any =333
eny =any+16
za =base+$9800
cardmem =za+2
songflag=za+110
pcards =za+112 ;player-cards
ccards =za+122 ;computer-cards
cpoint =za+132 ;cardpointer (naechste karte vom stapel)
save =za+140 ;joy-vectoren
savea =za+144
linea =za+148 ;linea-pointer
help =za+152 ;help-variable
apbet =za+154 ;aktuelle player-bet
gpbet =za+156 ;gesamte player-bet
acbet =za+158 ;aktuelle computer-bet
gcbet =za+160 ;gesamte computer-bet
antab =za+162 ;tabellenanfangspointer
choose =za+166 ;gemachte auswahl #
anz =za+168 ;anzahl of a kind
manz =za+170 ;anzahl-speicher
cardpr =za+174 ;karten-pruefspeicher
flushy =za+184 ;flush yes
stray =za+186 ;straight yes
hcbet =za+188 ;highest computer-bet
cflags =za+190 ;card-flags fuer strasse-chance
ncallk =za+208 ;karten nach call aussortieren lassen?
pot =za+210 ;amount auf pot
ayou =za+212 ;amount you
ame =za+214 ;amount me
haka =za+216 ;kartenhaben
hapl =za+218 ;kartenhaben player
haco =za+220 ;kartenhaben computer
pmanz =za+222 ;player memory kartenanz
calnr =za+226 ;call-nummer (1 oder 2)
vbet =za+228 ;war voriges ein stay? (1=ja)
dran =za+230 ;wer war zuletzt dran (0=player hat gecalled)
fac1 =za+234 ;help-bytes
fac2 =za+236
fac3 =za+238
fac4 =za+240
curpic =za+244 ;current pic auf bildschirm
newpic =za+246 ;neues pic fuer bildschirm
cgirl =za+248 ;gewaehltes girl
texlau =za+250 ;durchlaufender text
whichar =za+254 ;which char?
fac3e =za+256 ;extra fuer kartenauswahl
wor1 =za+260 ;words fuer bild
wor2 =za+262
wor3 =za+264
wor4 =za+266
col =za+268
extr1 =za+270
framcnt =za+274
facneu =za+278
exrand =za+282
source =za+288 ;source-adress von decompac
destanf =za+292 ;destination-anfangsadress von decompac
destend =za+296 ;destination-endadress von decompac
doslib =za+300 ;dos library pointer
conslib =za+304 ;console library pointer
handle =za+308
invers =za+312
anex =-24
OpenLibrary=anex-528
nados: dc.b "dos.library",0
ando =-24
Open =ando-6
Close =ando-12
Read =ando-18
Write =ando-24
nacons: dc.b "console.library",0
ancons =-42
RawKeyConvert =ancons-6
hdname: dc.b "df0:holldac",0
natit: dc.b "df0:tdat",0
masktab:dc.b 0,0,0,0,4,0,4,0,4,1,4,1,10,4,10,4,10,5,10,5,14,5,14,5
dc.b 14,11,14,11,15,13,15,15
txshuf: dc.b "i am shuffling",$1d,0
txwait: dc.b "please wait",$1b,0
txyour: dc.b "your cards",$1f,0
txmy: dc.b "my cards",$1f,0
txchoo: dc.b "please choose",$1b,0
txbet: dc.b "bet stay drop",0
txamo: dc.b "05 10 15 20 25",0
txcrf: dc.b "call raise drop",0
txcall1:dc.b "choose the cards",0
txcall2:dc.b "you do not want",$1b,0
txcall3:dc.b "you call",$1d,0
txhave: dc.b "you have ",0
txihave:dc.b "i have",0
txh1: dc.b "a pair",$1d,0
txh2: dc.b "two pairs",$1d,0
txh3: dc.b "three of a kind",$1d,0
txh4: dc.b "a straight",$1b,0
txh5: dc.b "a flush",$1b,0
txh6: dc.b "a full house",$1b,$1b,0
txh7: dc.b "four of a kind",$1b,$1b,0
txh8: dc.b "a straight flush",$1b,$1b,$1b,0
txcall: dc.b "i call",$1d,0
txraise:dc.b "i raise ",$1d,0
txfold: dc.b "i drop",$1d,0
txstay: dc.b "i stay",$1d,0
txpstay:dc.b "so we ante again",$1d,0
txibet: dc.b "i bet ",$1d,0
txyouw: dc.b "you win pot",$1d,0
txiw: dc.b "i win pot",$1d,0
txtake: dc.b "i take cards",$1d,0
tx1take:dc.b "i take 1 card",$1d,0
nametab:dc.b "df0:isa.1",0,"df0:lor.1",0,"df0:den.1",0,"df0:ste.1",0
defchar:dc.b $ff,$81,$bd,$a5,$a5,$bd,$81,$ff
dc.b $42,$5a,$5a,$42,$7e,0
defac: dc.b $fe,$82,$ba,$aa,$ba,$82,$fe,0
even
betab: dc.w 3,5,10,13,18,21,0,0
amotab: dc.w 2,3,7,8,12,13,17,18,22,23,0,0
crftab: dc.w 3,6,10,14,18,21,0,0
numtab: dc.b $21,$21,$21,$26,$22,$21,$22,$26,$23,$21,$23,$26,$24,$21
catab: dc.b 2,1,2,$87,0,2,1,2,4,2,$87,0,1,1,3,1,1,$87,3,$87,0 ;2-4
dc.b 1,1,3,1,1,$87,3,$87,2,4,0,1,1,1,4,1,$87,3,1,3,4,3,$87,0
dc.b 1,1,1,4,1,$87,3,1,3,4,3,$87,2,2,0 ;7
dc.b 1,1,1,4,1,$87,3,1,3,4,3,$87,2,2,2,$86,0 ;8
dc.b 1,1,1,3,1,$85,1,$87,3,1,3,3,3,$85,3,$87,2,4,0 ;9
dc.b 1,1,1,3,1,$85,1,$87,3,1,3,3,3,$85,3,$87,2,2,2,$86,0 ;10
dc.b 1,1,3,$87,0,1,1,3,$87,0,1,1,3,$87,0,2,4,0,0 ;J-A
pftab: dc.l 7*80+11520,163*80+11520,111*80+11520,59*80+11520
girl1a: dc.b 0, 15,40, 20,55, 20,80, 25,90, 20,100, 25,120, 25,120
dc.b 10,40, 15,90, 5,20
girl1b: dc.b 0, 5,35, 15,80, 20,120, 25,150, 20,220, 25,220, 25,220
dc.b 0,0, 0,0, 0,0
girl2a: dc.b 5, 10,25, 15,45, 20,80, 25,120, 25,120, 25,120, 25,120
dc.b 5,5, 5,5, 0,0
girl2b: dc.b 5, 5,35, 10,60, 15,100, 25,200, 25,200, 25,250, 25,250
dc.b 0,0, 0,0, 0,0
girl3a: dc.b 0, 15,20, 15,40, 25,80, 25,100, 25,120, 25,120, 25,120
dc.b 5,0, 5,0, 0,0
girl3b: dc.b 0, 5,35, 15,65, 15,65, 25,250, 25,250, 25,250, 25,250
dc.b 0,0, 0,0, 0,0
girl4a: dc.b 0, 15,5, 20,50, 25,80, 25,100, 25,120, 25,120, 25,120
dc.b 0,0, 0,0, 0,0
girl4b: dc.b 0, 5,20, 15,50, 15,60, 25,250, 25,250, 25,250, 25,250
dc.b 5,0, 5,0, 0,0
hnoth: dc.b 20
two: dc.b 15
htwo: dc.b 35
pairs: dc.b 20
hpairs: dc.b 55
three: dc.b 20
hthree: dc.b 80
stra: dc.b 25
hstra: dc.b 90
flu: dc.b 20
hflu: dc.b 100
full: dc.b 25
hfull: dc.b 120
four: dc.b 25
hfour: dc.b 120
stra1m: dc.b 10
hstra1m:dc.b 40
flu1m: dc.b 15
hflu1m: dc.b 90
stra2m: dc.b 5
hstra2m:dc.b 10
dc.b 0,0,0,0
even
hamgr =32
coplist:dc.w $2001,$ff00,$e0,$7,$e2,hamgr,$e4,$7,$e6,hamgr+$28,$e8,7
dc.w $ea,hamgr+$50,$ec,7,$ee,hamgr+$78,$f0,7,$f2,hamgr+$a0
dc.w $f4,7,$f6,hamgr+$c8,$108,$c6,$10a,$c6,$102,$00
dc.w $92,$38,$94,$d8
colta: dc.w $180,0,$182,0,$184,0,$186,0,$188,0,$18a,0,$18c,0,$18e,0
dc.w $190,0,$192,0,$194,0,$196,0,$198,0,$19a,0,$19c,0,$19e,0
dc.w $140,0,$142,1,$8e,$2881,$90,$f2c1,$2801,$ff00
onoff: dc.w $100,$6800
dc.w $120,0,$122,0,$124,0,$126,0,$128,0,$12a,0,$12c,0,$12e,0
dc.w $130,0,$132,0,$134,0,$136,0,$138,0,$13a,0,$13c,0,$13e,0
dc.w $b701,$ff00,$100,0,$180,0,$102,$00,$b801,$ff00
on2: dc.w $100,$a000,$108,$4d,$10a,$4d
dc.w $180,$222,$182,$222,$184,$222,$186,$222,$bf01,$ff00
bpnt: dc.w $e0,7,$e2,$86fe,$e4,7,$e6,$874e
colta2: dc.w $180,0,$184,$800,$182,$8,$186,$baa
dc.w $f301,$ff00,$180,0,$182,0,$184,0,$186,0
dc.w $ff01,$ff00,$0088,$ffff
even
;****** ByteRun1 Decompactor
decopic:move.l #decomem+$f4,a0
move.l #$78837,a1
dcp1: cmp.b #$80,(a0)
beq dcp2
cmp.l #30000+$78837,a1
bpl dcen ;ende?
tst.b (a0)
bmi dcp3
dcp4: nop ;copy n+1 bytes
clr.l d7
move.b (a0),d7
addq.w #1,d7
addq.l #1,a0
dcp5: move.b (a0),(a1)
addq.l #1,a0
addq.l #1,a1
subq.w #1,d7
tst.w d7
bne dcp5
jmp dcp1
dcp3: nop ;replicate next byte -n+1 times
clr.l d7
move.b (a0),d7
eor.b #$ff,d7
addq.w #2,d7
dcp6: move.b 1(a0),(a1)
addq.l #1,a1
subq.w #1,d7
tst.w d7
bne dcp6
addq.l #2,a0
jmp dcp1
dcp2: addq.l #1,a0 ;no operation
jmp dcp1
dcen: nop
rts
;****** load data
ldat: jsr resreg
move.l doslib,a5
move.l #hdname,d1
move.w #1005,d2
jsr Open(a5)
move.l d0,handle
move.l d0,d1
move.l #picmem,d2
move.l #11000,d3
jsr Read(a5)
move.l handle,d1
move.l d1,d2
jsr Close(a5)
move.l #picmem,source
move.l #holldat,destanf
move.l #holldat+32000,destend
jsr deco ;decompaktieren des geladenen bildes
ld1: rts
resreg: clr.l d0
clr.l d1
clr.l d2
clr.l d3
clr.l d4
clr.l d5
clr.l d6
clr.l d7
rts
;****** start vector
begin: nop
clr.b songflag
move.l #stack,a7
jsr totreset
jsr cldisp
jsr cl2disp
jsr iniall
move.w #0,curpic
move.w #1,newpic
move.w #3,cgirl
jsr picwork
jsr anftit
jsr iniall
jsr cldisp
jsr cl2disp
jsr ldat
jsr title
move.w #0,curpic
move.w #1,newpic
jsr test
jsr wait1
jsr wait1
jsr reini
b1: nop
rts
reini: nop
move.w #$8020,$dff09a
move.w #$ffff,$dff088
rts
;****** total reset bei erstem programmstart
totreset:nop
cmp.b #$1c,$60000
bne tre1
rts
tre1: move.l #$60000,a0
move.l #$20000,d7
tre2: clr.l (a0)
addq.l #4,a0
subq.l #4,d7
tst.l d7
bne tre2
rts
;****** initialize
iniall: nop
move.l $4,a5 ;doslibrary init
move.l #nados,a1
clr.l d0
jsr OpenLibrary(a5)
move.l d0,doslib
move.l #nacons,a1
clr.l d0
jsr OpenLibrary(a5)
move.l d0,conslib
move.w #100,ayou
move.w #100,ame
clr.w pot
move.l #coplist,$dff080
move.w #$ffff,$dff088
move.w #$20,$dff002 ;sprites aus
move.w #$a000,on2+2 ;init unteres window
move.w #$4d,on2+6
move.w #$4d,on2+10
move.w #$86fe,bpnt+6
move.w #$874e,bpnt+14
move.w #$800,colta2+6
move.w #8,colta2+10
move.w #$baa,colta2+14
rts
initit: move.w #$2000,on2+2 ;unteres window fuer titel
move.w #$27,on2+6
move.w #$27,on2+10
move.w #$f,colta2+6
move.w #$fc0,colta2+10
move.w #$c0f,colta2+14
rts
;****** clear display
;oberen bs clear
cldisp: move.l #screen+$20,a5
move.l #$8700,d6
cl1: move.l #0,(a5)
addq.l #4,a5
subq.w #4,d6
tst.w d6
bne cl1
rts
;unteren bs schwarz fuellen
cl2disp:move.l #screen+$8700,a5
move.w #$2200,d6
cl2: clr.l (a5)
addq.l #4,a5
subq.w #4,d6
tst.w d6
bne cl2
rts
;****** card display
;a5=stelle, d4=farbe (0-3), d5=kartennr. (0-12)
cdisp: nop
movem.l d0-d7/a0-a6,-(sp)
move.l d4,d2
move.l a5,a0
move.l a5,a0
clr.l (a0)
clr.l 4(a0)
clr.w 8(a0)
clr.l 80(a0)
clr.l 84(a0)
clr.w 88(a0)
clr.l 8160(a0)
clr.l 8164(a0)
clr.w 8168(a0)
clr.l 8240(a0)
clr.l 8244(a0)
clr.w 8248(a0)
move.l #$1fffffff,160(a0)
move.l #-1,164(a0)
move.w #$fff8,168(a0)
move.l #$1fffffff,240(a0)
move.l #-1,244(a0)
move.w #$fff8,248(a0)
move.l #$1fffffff,8000(a0)
move.l #-1,8004(a0)
move.w #$fff8,8008(a0)
move.l #$1fffffff,8080(a0)
move.l #-1,8084(a0)
move.w #$fff8,8088(a0)
add.l #320,a0
move.b #6*8,d7
cd0b: move.l #$7fffffff,(a0)
move.l #$7fffffff,80(a0)
move.l #-1,4(a0)
move.l #-1,84(a0)
move.w #$fffe,8(a0)
move.w #$fffe,88(a0)
add.l #160,a0
subq.b #1,d7
tst.b d7
bne cd0b
cmp.b #$ff,d5
beq cumg
cmp.b #9,d5 ;bube?
bne pd1
move.l #holldat,a0
jmp pdisp
pd1: cmp.b #10,d5 ;dame?
bne pd2
move.l #holldat+20,a0
jmp pdisp
pd2: cmp.b #11,d5 ;koenig?
bne pd3
move.l #holldat+40,a0
jmp pdisp
pd3: clr.l d7
move.b d5,d7
asl.b #2,d7
add.l #holldat+336-160,d7
move.l d7,a1
move.l a5,a4
add.l #4*80,a4
move.l a5,a0
add.l #49*160+8,a0
move.b #7,d7
cd0: move.w (a1),d0
lsr.w #1,d0
move.w #$7fff,(a4)
move.w #$7fff,80(a4)
eor.w d0,(a4)
btst #1,d4
beq cdr1 ;rot
eor.w d0,80(a4) ;schwarz
cdr1: move.w (a1),d0
jsr umkehr
move.w #$fffe,(a0)
move.w #$fffe,80(a0)
eor.w d3,(a0)
btst #1,d4
beq cdr2 ;rot
eor.w d3,80(a0) ;schwarz
cdr2: add.l #160,a4
add.l #160,a1
sub.l #160,a0
subq.b #1,d7
tst.b d7
bne cd0
addq.l #2,a5
and.l #3,d4
asl.b #2,d4
add.l #holldat,d4 ;d4=kartensymbol anf
move.l #catab,a0
move.b d5,d7
tst.b d7
beq cd2
cd1: addq.l #1,a0
tst.b (a0)
bne cd1
subq.b #1,d7
tst.b d7
bne cd1
addq.l #1,a0
cd2: nop ;a0=catab-stelle
move.l a5,a4 ;bs-stelle fuer kartensymbol
tst.b (a0)
beq cd3 ;letztes symbol fertig?
clr.l d0
move.b (a0),d0
subq.b #1,d0
asl.b #1,d0
add.l d0,a4 ;spalte dazu
move.b 1(a0),d0
and.b #$7f,d0
subq.b #1,d0
mulu #44,d0
divu #7,d0
mulu #160,d0
add.l #320,d0
add.l d0,a4 ;zeile dazu
tst.b 1(a0)
bmi cd4 ;symbol umgekehrt?
move.l d4,a1 ;symbol anf
move.b #10,d7
cd5: move.w (a1),d6
move.w #-1,(a4)
move.w #-1,80(a4)
eor.w d6,(a4)
btst #1,d2
beq cdr5
eor.w d6,80(a4)
cdr5: add.l #160,a1
add.l #160,a4
subq.b #1,d7
tst.b d7
bne cd5
jmp cd6
cd4: move.l d4,a1
add.l #10*160,a1
move.b #11,d7
cd7: move.w (a1),d6
move.w #-1,(a4)
move.w #-1,80(a4)
eor.w d6,(a4)
btst #1,d2
beq cdr7
eor.w d6,80(a4)
cdr7: sub.l #160,a1
add.l #160,a4
subq.b #1,d7
tst.b d7
bne cd7
cd6: addq.l #2,a0
jmp cd2
cd3: nop ;letztes symbol fertig
cdret: movem.l (sp)+,d0-d7/a0-a6
rts
umkehr: move.b #16,d1
uk1: roxl.w #1,d0
roxr.w #1,d3
subq.b #1,d1
tst.b d1
bne uk1
asl.w #2,d3
rts
cumg: nop
add.l #640,a5
move.b #44,d7
cu1: eor.b #$55,81(a5)
eor.l #$55555555,82(a5)
eor.w #$5555,86(a5)
eor.b #$55,88(a5)
add.l #160,a5
eor.b #$aa,1(a5)
eor.l #$aaaaaaaa,2(a5)
eor.w #$aaaa,6(a5)
eor.b #$aa,8(a5)
add.l #160,a5
subq.b #2,d7
tst.b d7
bne cu1
jmp cdret
pdisp: nop ;picture darstellen a0=jqk-offset
clr.l d1
move.b d4,d1
asl.b #2,d1
add.l #pftab,d1
move.l d1,a1
move.l (a1),d1
add.l d1,a0
sub.l #80,a0
move.b #23,d7
move.l a5,a4
add.l #3*160,a4
move.l a4,a3
add.l #44*160,a3
pd7: move.l #0,a1
move.l #8,a2
move.l #0,a6
pd4: move.w (a0,a6),d3
eor.w #$ffff,d3
move.w d3,(a4,a1)
btst #1,d4
;beq pd5
move.w d3,80(a4,a1)
pd5: move.w (a0,a6),d0
jsr mirr
eor.w #$ffff,d3
move.w d3,(a3,a2)
btst #1,d4
;beq pd6
move.w d3,80(a3,a2)
pd6: addq.l #2,a1
subq.l #2,a2
addq.l #4,a6
move.l a2,d3
tst.l d3
bpl pd4
add.l #160,a0
add.l #160,a4
sub.l #160,a3
subq.b #1,d7
tst.b d7
bne pd7
jmp pd3
mirr: move.b #16,d6
mir1: roxr.w #1,d0
roxl.w #1,d3
subq.b #1,d6
tst.b d6
bne mir1
rts
;****** test-routine
test: nop
jsr cl2disp
jsr twind
jsr picwork
tst.w ayou
beq begin
bmi begin
move.b #3,songflag
jsr shuf ;karten mischen
tebg: clr.w ncallk
clr.w calnr
clr.w acbet
clr.w apbet
clr.w vbet
subq.w #5,ayou
subq.w #5,ame
add.w #10,pot ;ante
jsr distant
jsr allumg ;karten umgedreht
jsr igirla
jsr kartz ;karten ziehen (p=5, c=5), karten anzeigen
clr.w gpbet
clr.w gcbet
move.b #0,songflag
move.l #tes2,-(sp) ;fuer 2.ebene rts
tst.b dran
bne b3
tes3: jsr dopl
b3: jsr doco
b2: jmp tes3
tes2: nop
jmp test
rts
;****** pic abarbeiten
picwork:move.w newpic,d0
cmp.w curpic,d0
bne pw1
rts
pw1: nop
jsr resreg
clr.l d0
move.w cgirl,d0
mulu #10,d0
add.l #nametab,d0
move.l d0,a0
move.w #$0800,onoff+2
move.l doslib,a5
move.b newpic+1,8(a0)
add.b #$30,8(a0)
move.l a0,d1
move.w #1005,d2
jsr Open(a5)
move.l d0,handle
move.l d0,d1
move.l #screen,d2
move.l #$8700,d3
jsr Read(a5)
move.l handle,d1
move.l d1,d2
jsr Close(a5)
move.l #screen+2,a0
move.l #colta+6,a1
move.b #15,d7
hr1: move.w (a0),(a1)
addq.l #2,a0
addq.l #4,a1
subq.b #1,d7
tst.b d7
bne hr1
move.w #$6800,onoff+2
move.w newpic,curpic
cmp.w #5,curpic
beq win
clr.l d0
move.w cgirl,d0
addq.w #1,d0
asl.w #4,d0
add.w newpic,d0
fab: cmp.b $70000,d0
bne fab
rts
;****** Decompaktier-Routine fuer HG-Format
deco: move.l destanf,a1
move.l source,a0
dec1: nop
cmp.b #$48,(a0)
bne dec3
cmp.b #$47,1(a0)
bne dec3
clr.l d7
move.b 3(a0),d7
asl.w #8,d7
move.b 4(a0),d7
dec2: move.b 2(a0),(a1)
addq.l #1,a1
cmp.l destend,a1
beq dece
subq.w #1,d7
tst.w d7
bne dec2
addq.l #5,a0
dec4: move.l a1,d1
sub.l destend,d1
tst.l d1
bmi dec1
dece: rts
dec3: move.b (a0),(a1)
addq.l #1,a0
addq.l #1,a1
cmp.l destend,a1
beq dece
jmp dec4
;****** mischen der karten
misch: move.l #cardmem,a0 ;anf des kartenstapels
move.l #cardmem,cpoint ;kartenpointer auf anfang
move.b #104,d7
mi1: move.b #$ff,(a0)
addq.l #1,a0
subq.b #1,d7 ;loeschen des stapels
tst.b d7
bne mi1
move.b #0,d0 ;farbe auf karo
move.b #0,d1 ;kartennr. auf "2"
mi2: movem.l d0/d1,-(sp)
move.w $dff006,d0
lsr.w #4,d0
add.w $dff006,d0
move.l d0,d2
movem.l (sp)+,d0/d1
and.l #$3f,d2
sub.b #52,d2 ;rnd-zahl von 0-51
tst.b d2
bpl mi2
add.b #52,d2
asl.b #1,d2
add.l #cardmem,d2
move.l d2,a2
cmp.w #$ffff,(a2)
bne mi2
move.b d0,(a2)
move.b d1,1(a2)
addq.b #1,d1 ;kartennr. erh”hen
cmp.b #13,d1
bne mi2
add.b #1,d0
clr.b d1
cmp.b #4,d0
bne mi2
rts
;****** transpose window
twind: movem.l d0-d7/a0-a6,-(sp)
jsr tw2
jsr distant
movem.l (sp)+,d0-d7/a0-a6
rts
tw2: move.l #screen+caoff+370,a0
move.l #holldat+wimoff-80,a1
move.w #46,d7
tw0: move.l #28,a2
move.l #56,a3
tw1: move.w (a1,a3),d0
eor.w #$ffff,d0
move.w d0,(a0,a2)
move.w d0,80(a0,a2)
subq.l #2,a2
subq.l #4,a3
move.l a2,d3
tst.l d3
bpl tw1
add.l #160,a1
add.l #160,a0
subq.b #1,d7
tst.b d7
bne tw0
move.l #46*160,a0
add.l #screen+caoff+370,a0
move.l #28,a1
tw3: move.w #-1,(a0,a1)
move.w #-1,80(a0,a1)
subq.l #2,a1
move.l a1,d3
tst.l d3
bpl tw3
rts
;****** display stand
distant:nop
move.l #screen+caoff+370,a0
move.l #holldat+wimoff-80,a1
move.b #10,d7
jsr tw0
move.l #screen+857+160+caoff,a5
move.w pot,d0
jsr disp3zif ;3-ziffrige zahl darstellen
dt2: tst.w ame
bpl dt1
add.w #100,ame
addq.w #1,newpic
jmp dt2
dt1: nop
move.w ame,d0
sub.w #100,d0
bmi dt3
cmp.w #1,newpic
beq dt3
subq.w #1,newpic
sub.w #100,ame
jmp dt1
dt3: nop
move.w ayou,d5
tst.w ayou
bpl dt4
move.w #0,d5
dt4: move.l #screen+866+160+caoff,a5
move.w d5,d0
jsr disp3zif
move.l #screen+874+160+caoff,a5
move.w ame,d0
jsr disp3zif
rts
disp3zif:nop
move.l #1,wor1
clr.l d1
move.w d0,d1
and.l #$ffff,d0
divu #100,d0
move.l d0,d2
add.b #$21,d0
jsr chrout
addq.l #1,a5
move.l d2,d0
swap d0
and.l #$ffff,d0
divu #10,d0
move.l d0,d2
add.b #$21,d0
jsr chrout
move.l d2,d0
swap d0
and.l #$ffff,d0
add.b #$21,d0
addq.l #1,a5
jsr chrout
rts
;****** character out
;d0=character, a5=pos
chrout: and.l #$ff,d0
movem.l d0/d7/a0,-(sp)
move.l a5,fac1
move.l #160,d3
cmp.b #$2b,d0
bne co1a
move.l #defchar,a0
move.b #1,d3
jmp co2a
co1a: subq.b #1,d0
asl.b #1,d0
btst #1,d0
beq co6
subq.b #1,d0
co6: add.l #holldat+chranf,d0
move.l d0,a0
co2a: move.b #7,d7
co1: move.b (a0),d0
tst.b invers
bne coimn
eor.b #$ff,d0
coimn: move.b d0,(a5)
move.b d0,80(a5)
add.l d3,a0
add.l #160,a5
subq.b #1,d7
tst.b d7
bne co1
movem.l (sp)+,d0/d7/a0
move.l fac1,a5
rts
;****** text ausgeben
;a0=anfangspos ab window, a1=text
txtout: nop
move.l a0,d1
and.l #$7fff,d1
add.l #screen+370+caoff,d1
move.l d1,a0
entx: move.l a0,a5
to1: move.b (a1),d0
move.b d0,d1
and.b #$f0,d1
cmp.b #$10,d1
bne to5
add.b #$11,d0
jmp to3
to5: cmp.b #$30,d1
bne to4
sub.b #$0f,d0
jmp to3
to4: cmp.b #$20,d0
beq to3
cmp.b #$2a,d0
bne to3e
addq.b #1,d0
jmp to3
to3e: and.b #$1f,d0
tst.b d0
beq to2
to3: jsr chrout
addq.l #1,a5
addq.l #1,a1
jmp to1
to2: rts
;****** shuffle
shuf: nop
move.l #txshuf,a1
move.l #melf+6,a0
jsr txtout
move.l #txwait,a1
move.l #umelf,a0
jsr txtout
jsr misch
move.l #$50000,d6
sh1: subq.l #1,d6
tst.l d6
bne sh1
rts
;****** alle karten umgedreht
allumg: move.l #screen,a5
add.l #caoff,a5
move.b #$ff,d4
move.b #$ff,d5
move.l #10,d1
alum1: nop
jsr cdisp
add.l d1,a5
jsr cdisp
add.l d1,a5
jsr cdisp
add.l d1,a5
jsr cdisp
add.l d1,a5
jsr cdisp
rts
;****** karten ziehen (p=5, c=5) und karten anzeigen
kartz: nop
jsr twind
move.l #txyour,a1
move.l #melf+8,a0
jsr txtout
move.l #$30000,d6
jsr waite
move.l #pcards,a0
move.l #ccards,a1
move.l #screen,a5
add.l #caoff,a5
move.l #10,d1
kz0a: move.b #5,d7
kz1: jsr getcard
move.b d4,(a0)
move.b d5,1(a0)
jsr cdisp
jsr getcard
move.b d4,(a1)
move.b d5,1(a1)
move.l #$10000,d6
jsr waite
addq.l #2,a0
add.l d1,a5
addq.l #2,a1
subq.b #1,d7
tst.b d7
bne kz1
move.l #$30000,d6
jsr waite
rts
;****** karte aus stapel holen
getcard:move.l cpoint,a6
move.b (a6),d4
move.b 1(a6),d5
addq.l #2,cpoint
rts
;****** bet stand fold
betq: nop ;bet, stand oder fold?
jsr twind
move.l #txchoo,a1
move.l #umelf,a0
jsr txtout
move.l #txbet,a1
move.l #melf+3,a0
jsr txtout
nop
move.l #betab,a5
jsr chopa
jmp been
chopa: nop
move.l a5,antab ;pointer auf anfang
clr.w choose
cop1: jsr abfrag
tst.b d0
bne cop1
move.b #1,d5
move.b #0,help
be4: jsr indic
move.l #$3000,d6
jsr waite
be1: nop
be2: jsr abfrag
cmp.b help,d0
beq be1
move.b d0,help
btst #7,d0
bne bert
btst #2,d0
beq be3
cmp.l antab,a5
beq be1
jsr indic
subq.l #4,a5
subq.b #1,choose
move.b help,d0
jmp be4
be3: btst #3,d0
beq be1
tst.l 4(a5)
beq be1
jsr indic
addq.l #4,a5
addq.b #1,choose
jmp be4
bert: move.l #$3000,d6
jsr waite
ber2: jsr abfrag
tst.b d0
bne ber2
rts
been: nop
cmp.b #1,choose ;stand?
bne be5
move.b #0,apbet ;dann player-bet =0
jsr twind
tst.b vbet
beq benvs
move.b #2,vbet
tst.b calnr
bne benvsb
move.l #txpstay,a1
move.l #melf,a0
jsr txtout
jsr wait1
jsr twind
movem.l (sp)+,d0-d1
jmp tebg
benvsb: jmp pc1a
benvs: move.b #1,vbet
rts
be5: nop ;fold?
clr.w vbet
cmp.b #2,choose
bne be6
move.b #-1,apbet
rts
be6: nop ;bet
jsr twind ;window loeschen
move.l #txamo,a1
move.l #melf+2,a0
jsr txtout
move.l #txchoo,a1
move.l #umelf,a0
jsr txtout
move.l #amotab,a5
jsr chopa
bein: jsr twind ;window loeschen
clr.l d0
move.b choose,d0
addq.b #1,d0
mulu #5,d0
move.b d0,apbet
add.b d0,gpbet ;bet registrieren
rts
;****** player wins
win: nop
jsr cl2disp
jsr beginsn
jsr init
move.l #song2a,poi1
move.l #song2b,poi1+4
move.l #song2c,poi1+8
move.l #song2d,poi1+12
wiq1: jsr swork
move.w #405,d7
wiq2: jsr abfrag
btst #7,d0
bne wiq3
subq.w #1,d7
bne wiq2
jmp wiq1
wiq3: move.w #$f,$dff096 ;sound off
jmp begin
;****** player call raise fold
pcarafo:nop
clr.w vbet
pca: jsr twind ;window loeschen
move.l #txcrf,a1
move.l #melf+3,a0
jsr txtout
move.l #txchoo,a1
move.l #umelf,a0
jsr txtout
move.l #crftab,a5
jsr chopa
cmp.b #2,choose ;fold?
bne pc1
move.b #-1,apbet
rts
pc1: tst.b choose ;call?
bne pc2
pc1a: move.w acbet,d0
lsr.w #8,d0
add.w d0,pot
sub.w d0,ayou
clr.w acbet
jsr distant
move.b #0,apbet
tst.w ncallk
bne pcar
jsr pcall
pcar: rts
pc2: nop ;raise
move.b apbet,d1
add.b d1,gpbet
jsr twind
move.l #txamo,a1
move.l #melf+2,a0
jsr txtout
move.l #txchoo,a1
move.l #umelf,a0
jsr txtout
move.l #amotab,a5
jsr chopa
jmp bein
pcall: nop
pcal1: jsr twind
move.l #txcall3,a1
move.l #melf+8,a0
jsr txtout
p2call: move.l #txcall1,a1
move.l #umelf,a0
jsr txtout
move.l #txcall2,a1
move.l #1280+umelf,a0
jsr txtout
move.l #10,facneu
yq0: move.l #caoff,a4 ;aktuelle kartenposition
move.l #pcards,a3 ;aktuelle karte im speicher
move.l #1,d7
ca: nop
subq.w #1,d7
tst.w d7
bne ca1
move.w #3000,d7
jsr invcard
ca1: move.b d0,help
jsr abfrag
cmp.b help,d0
beq ca
btst #7,d0
bne cain
btst #2,d0
beq ca2
cmp.l #pcards,a3
beq ca
jsr carich ;karte wieder richtig darstellen
sub.l facneu,a4
subq.l #2,a3
move.w #1,d7
jmp ca
ca2: btst #3,d0
beq ca
cmp.l #pcards+8,a3
beq ca
jsr carich
add.l facneu,a4
addq.l #2,a3
move.w #1,d7
jmp ca
rts
carich: move.b (a3),d4
move.b 1(a3),d5
tst.b 1(a3)
bpl cri1
move.b #$ff,d5
cri1: move.l a4,a5
move.l a5,d2
and.l #$ffff,d2
move.l d2,a5
add.l #screen,a5
jsr cdisp
rts
invcard:nop
move.l a4,a0
move.l a0,d2
and.l #$ffff,d2
move.l d2,a0
add.l #screen+160,a0
move.b #50,d2
ica1: eor.l #$ffffffff,(a0)
eor.l #$ffffffff,4(a0)
eor.w #$ffff,8(a0)
add.l #160,a0
subq.b #1,d2
tst.b d2
bne ica1
rts
cain: nop
btst #0,d0
bne caen
add.b #$80,1(a3)
jsr carich
jmp ca
caen: nop
jsr twind
jsr carich
move.l #$30000,d6
jsr waite
move.l #caoff,a4
move.l #pcards,a3
move.l #10,fac3e
ca4: tst.b 1(a3)
bpl ca5
jsr getcard
move.l a4,a5
move.l a5,d0
and.l #$ffff,d0
move.l d0,a5
add.l #screen,a5
jsr cdisp
move.b d4,(a3)
move.b d5,1(a3)
move.l #$18000,d6
jsr waite
ca5: addq.l #2,a3
add.l fac3e,a4
cmp.l #pcards+10,a3
bne ca4
rts
;****** computer call raise fold
ccarafo:nop
clr.w vbet
jsr twind
move.l #ccards,a5
jsr betcalc ;was schon vorhanden?
jsr betcalc2 ;auf was besteht chance? + wette ausr.
clr.l d0
move.b hcbet,d0 ;hoechstmoeglicher computerbet
clr.l d2
move.b gcbet,d2
add.b gpbet,d2
sub.w d2,d0
tst.w d0
bpl cc1
add.w #55,d0
tst.w d0
bpl cc2
move.b #-1,acbet ;fold
move.l #txfold,a1
move.l #melf,a0
jsr txtout
jsr wait1
rts
cc2: move.b #0,acbet ;call
move.l #txcall,a1
move.l #melf,a0
jsr txtout
jsr wait1
rts
cc1: nop ;raise
move.b acbet,d1
sub.b d1,d0
tst.b d0
bpl cc1a
add.b acbet,d0
cc1a: move.b acbet,d1
add.b d1,gcbet
tst.b acbet
beq cc2
move.l #txraise,a1
move.l #melf,a0
jsr txtout
clr.l d0
move.b acbet,d0
divu #5,d0
asl.b #1,d0
add.l #numtab,d0
move.l d0,a6
move.l #4*80+melf+58+caoff,a5
add.l #screen,a5
move.b (a6),d0
jsr chrout
move.l #4*80+melf+59+caoff,a5
add.l #screen,a5
move.b 1(a6),d0
jsr chrout
jsr wait1
rts
wait1: move.l #$78000,d6
waite: lsr.l #6,d6
and.l #$ffff,d6
asl.l #6,d6
w1: subq.l #1,d6
tst.l d6
bne w1
rts
;****** computer-bet
betqc: nop
jsr twind
move.l #ccards,a5
jsr betcalc
jsr betcalc2
clr.l d0
move.b hcbet,d0
clr.l d2
move.b gcbet,d2
add.b gpbet,d2
sub.w d2,d0
tst.w d0
bpl bc1
add.w #45,d0
tst.w d0
bpl bc2
clr.w vbet
move.b #-1,acbet ;fold
move.l #txfold,a1
move.l #melf,a0
jsr txtout
jsr wait1
rts
bc2: move.b #0,acbet ;stay
move.l #txstay,a1
move.l #melf,a0
jsr txtout
jsr wait1
tst.w vbet
beq bc2a
move.b #2,vbet
tst.b calnr
bne bc2b
jsr twind
move.l #txpstay,a1
move.l #melf,a0
jsr txtout
jsr wait1
movem.l (sp)+,d0-d1
jmp tebg
bc2b: move.b #0,acbet
move.b #2,vbet
rts
bc2a: move.b #1,vbet
rts
bc1: nop ;bet
move.b acbet,d1
sub.b d1,d0
tst.b d0
bpl bc1a
add.b acbet,d0
bc1a: move.b acbet,d1
add.b d1,gcbet
tst.b acbet
beq bc2
clr.w vbet
move.l #txibet,a1
move.l #melf,a0
jsr txtout
clr.l d0
move.b acbet,d0
divu #5,d0
asl.b #1,d0
add.l #numtab,d0
move.l d0,a6
move.l #4*80+melf+56+caoff,a5
nl1: move.l a5,d0
and.l #$ffff,d0
move.l d0,a5
add.l #screen,a5
move.b (a6),d0
jsr chrout
add.l #1,a5
move.b 1(a6),d0
jsr chrout
jsr wait1
rts
;****** indicate kasten
;pointer auf zwei words in a5
indic: move.l d0,-(sp)
clr.l d0
move.w (a5),d0
move.l d0,a0
ic1: move.l #screen+caoff+melf+210,a1
move.b #9,d7
ic2: eor.b #$ff,(a0,a1)
add.l #160,a1
subq.b #1,d7
tst.b d7
bne ic2
move.l a0,d0
cmp.w 2(a5),d0
beq ic3
addq.l #1,a0
jmp ic1
ic3: move.l (sp)+,d0
rts
;****** Wette errechnen Masterroutine
;kartenanfang in a5
betcalc:nop
move.l a5,a6
jsr cainpr ;karten in pruefmem uebertragen
nop ;wieviele karten of a kind?
clr.l manz
move.l #cardpr,a4 ;aeusserer search = a4
move.l a6,a0 ;aeusserer search auf richtige karten
cp1: move.l a4,a5 ;innerer search = a5
move.l a0,a1 ;innerer search auf richtige karten
clr.b anz ;anzahl auf 0
cmp.b #$ff,1(a4)
beq cp5
addq.l #2,a5 ;innerer search 2 hinter aeusserer
addq.l #2,a1
cp2: move.b 1(a4),d0
cmp.b 1(a5),d0 ;gleiche kind?
bne cp3
move.b #$ff,1(a5) ;dann karte loeschen
or.b #$80,(a0) ;karten nicht mehr weggeben
or.b #$80,(a1)
addq.b #1,anz ;anzahl incrementieren
cp3: addq.l #2,a5
addq.l #2,a1
cmp.l #cardpr+10,a5 ;ende der inneren schleife?
bne cp2
tst.b anz
bne cp4
cp5: addq.l #2,a4
addq.l #2,a0
cmp.l #cardpr+8,a4 ;ende der aeusseren schleife?
bne cp1
jmp cp6
cp4: move.l #manz,a3 ;mehrere karten einer kind gefunden
tst.b (a3)
beq cp7
addq.l #2,a3
cp7: addq.b #1,anz
move.b anz,(a3)
move.b 1(a4),1(a3) ;auf mem: anzahl, kind
jmp cp5
cainpr: move.l (a5),cardpr
move.l 4(a5),cardpr+4
move.w 8(a5),cardpr+8
rts
cp6: nop
move.l a6,a5
jsr cainpr ;pruefen, ob flush
clr.w flushy
move.l #cardpr,a5
move.b (a5),d0
and.b #$7f,d0
addq.l #2,a5
cp8: move.b (a5),d1
and.b #$7f,d1
cmp.b d0,d1
bne cp9
addq.l #2,a5
cmp.l #cardpr+10,a5
bne cp8
move.b #1,flushy
or.l #$80008000,(a6)
or.b #$80,8(a6)
cp9: nop ;pruefen, ob straight
clr.w stray
move.l a6,a5
jsr cainpr
move.b #$0a,help ;niedrigste karte auf hoch
move.l #cardpr,a4
cp10: move.b 1(a4),d0
sub.b help,d0
tst.b d0
bpl cp11
move.b 1(a4),help ;niedrigste karte suchen
cp11: addq.l #2,a4
cmp.l #cardpr+10,a4
bne cp10
move.b #5,d7
cp15: move.l #cardpr,a4
cp12: move.b 1(a4),d0
cmp.b help,d0
beq cp13
addq.l #2,a4
cmp.l #cardpr+10,a4
bne cp12
jmp cp14
cp13: addq.b #1,help
subq.b #1,d7
tst.b d7
bne cp15
move.b #1,stray
or.l #$80008000,(a6)
or.b #$80,8(a6)
cp14: nop
rts
;****** wette ausrechnen 2. Teil: Chancen berechnen + Wette ausrechnen
betcalc2:nop
tst.b stray ;schon strasse?
beq cp16
move.b stra,acbet
move.b hstra,hcbet
jmp cpmo
cp16: tst.b flushy
beq cp17
move.b flu,acbet
move.b hflu,hcbet
jmp cpmo
cp17: cmp.b #4,manz ;4er?
bne cp18
move.b four,acbet
move.b hfour,hcbet
jmp cpmo
cp18: cmp.b #3,manz ;3er oder full house?
bne cp19
move.b three,acbet
move.b hthree,hcbet
cmp.b #2,manz+2
bne cpmo
cp19b: move.b full,acbet ;full house
move.b hfull,hcbet
jmp cpmo
cp19: cmp.b #2,manz ;2er, 2x2 oder full house
bne cp19a
move.b two,acbet
move.b htwo,hcbet
tst.b manz+2
beq cpmo
move.b pairs,acbet
move.b hpairs,hcbet
cmp.b #2,manz+2
beq cpmo
jmp cp19b
cp19a: nop ;bisher noch nichts
move.l a5,a6 ;a5=pointer auf karten
jsr cainpr ;pruef auf strassenchance (1 o. 2 fehlen)
move.l #cardpr,a4
clr.l cflags ;alle strassenflags reset
clr.l cflags+4
clr.l cflags+8
clr.l cflags+12
cp20: move.l #cflags,a3 ;anfang der cflags
clr.l d0
move.b 1(a4),d0
add.l d0,a3
move.b #1,(a3) ;entsprechendes flag setzen
addq.l #2,a4
cmp.l #cardpr+10,a4
bne cp20
move.l #cflags,a3
cp21: move.l a3,a2
tst.b (a3) ;1. karte da?
beq cp26
move.b #5,d7 ;5 karten untersuchen
clr.l d6 ;hintereinander-karten-counter reset
cp23: tst.b (a2) ;karte da?
beq cp22
addq.b #1,d6 ;ja, counter erhoehen
cp22: addq.l #1,a2
subq.b #1,d7
tst.b d7 ;ende innere schleife
bne cp23
cmp.b #4,d6 ;fehlt eine karte?
beq cp24
cmp.b #3,d6 ;fehlen 2 karten?
beq cp24b
cp26: addq.l #1,a3
cmp.l #cflags+10,a3
bne cp21
jmp cp27
cp24: nop ;eine karte fehlt
move.b stra1m,acbet
move.b hstra1m,hcbet
jsr straca ;strassen-karten behalten
jmp cpmo ;zum wetten-modify
cp24b: nop ;zwei karten fehlen
move.b stra2m,acbet
move.b hstra2m,hcbet
jsr straca ;strassen-karten behalten
jmp cpmo ;zum wetten-modify
cp27: nop ;nichts vernuenftiges vorhanden
jsr cainpr ;pruef auf flush-chance (1 fehlt)
clr.b d6 ;farbe
cp28: move.l #cardpr,a3
clr.w d7
cp29: move.b (a3),d0
and.b #$7f,d0
cmp.b d0,d6
bne cp30
addq.b #1,d7
cp30: addq.l #2,a3
cmp.l #cardpr+10,a3
bne cp29
addq.b #1,d6
cmp.b #4,d6
beq cp31
cmp.b #4,d7
bne cp28
move.b flu1m,acbet
move.b hflu1m,hcbet
nop
cpmo: nop ;wetten-modify
jsr getqkb ;quersumme der zu behaltenden karten holen
subq.b #4,d0
tst.b d0
bpl cp32
subq.b #5,acbet ;niedrig, also 5 subtrahieren
jmp cp33
cp32: subq.b #4,d0
tst.b d0
bpl cp34
jmp cp33 ;mittel, also so lassen
cp34: addq.b #5,acbet ;hoch, also 5 addieren
cp33: cmp.b #-5,acbet
bne cp35
clr.b acbet
jmp cpend
cp35: cmp.b #30,acbet
bne cpend
move.b #25,acbet
cpend: nop
rts ;ende der berechnung
getqkb: nop ;quersumme der zu behaltenden karten berechnen
clr.l d6 ;kartencounter
clr.l d7 ;summe
clr.l d0 ;quersumme
move.l a6,a5
jsr cainpr
move.l #cardpr,a3
cp37: move.b (a3),d0
and.b #$80,d0
tst.b d0
beq cp38
addq.b #1,d6
add.b 1(a3),d7
cp38: addq.l #2,a3
cmp.l #cardpr+10,a3
bne cp37
tst.b d6
beq cp39
divu d6,d7
move.b d7,d0
rts
cp39: move.b #0,d0
rts
cp31: nop ;absolut nichts gefunden **
move.b #0,acbet
move.b hnoth,hcbet
jmp cpmo
straca: nop ;strassen-karten behalten
move.b #5,d7
sc1: tst.b (a3)
beq sc2
move.l a6,a4
move.b #5,d6
sc3: move.l a3,d0
sub.l #cflags,d0
cmp.b 1(a4),d0
bne sc4
or.b #$80,(a4)
jmp sc2
sc4: addq.l #2,a4
subq.b #1,d6
tst.b d6
bne sc3
nop ;error
jmp b1
sc2: addq.l #1,a3
subq.b #1,d7
tst.b d7
bne sc1
rts
;****** anzeigen was der player hat
ihanz: nop
move.l #txihave,a1
move.l #umelf+1280,a0
jsr txtout
move.l #umelf+1287,a0
jmp han1
hanz: jsr twind
move.l #txhave,a1
move.l #umelf,a0
jsr txtout
move.l #umelf+9,a0
han1: tst.l manz
bne ha1
tst.b flushy
bne ha1
tst.b stray
bne ha1
jsr twind
clr.w haka
rts
ha1: nop
cmp.b #4,manz
bne ha2
move.l #txh7,a1
jsr txtout
move.w #7,haka
jmp haw
ha2: cmp.b #3,manz
bne ha3
cmp.b #2,manz+2
bne ha4
ha7b: move.l #txh6,a1
jsr txtout
move.w #6,haka
jmp haw
ha4: move.l #txh3,a1
jsr txtout
move.w #3,haka
jmp haw
ha3: cmp.b #2,manz+2
bne ha7a
move.l #txh2,a1
jsr txtout
move.w #2,haka
jmp haw
ha7a: cmp.b #3,manz+2
beq ha7b
ha7: tst.b flushy
beq ha8
tst.b stray
beq ha9
move.l #txh8,a1
jsr txtout
move.w #8,haka
jmp haw
ha9: move.l #txh5,a1
jsr txtout
move.w #5,h
Editor is loading...