Hollywood Poker source code (Amiga)

 avatar
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...