Hollywood Poker source code (Amiga)
unknown
assembly_x86
a year ago
43 kB
34
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...