->
-> ANNVIT CÆPTIS MDCCLXXVI!
->
->    Hall of Fame client 1.4 stab
->
-> $NSAREG: 23F27N06OR2748D5894.3 [Crassus]
->
-> Copyright © 1995 Psilocybe Software
->
-> This program is free software; you can redistribute it and/or modify
-> it under the terms of the GNU General Public License as published by
-> the Free Software Foundation; either version 2 of the License, or
-> (at your option) any later version.
->
-> This program is distributed in the hope that it will be useful,
-> but WITHOUT ANY WARRANTY; without even the implied warranty of
-> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-> GNU General Public License for more details.
->
-> You should have received a copy of the GNU General Public License
-> along with this program; if not, write to the Free Software
-> Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
->
-> $HISTORY:
->
-> 22 Sep 1995 : 001.005 :  Understands SNAKE_HIDE/SHOWINTERFACE
-> 13 Sep 1995 : 001.004 :  Performs simple encryption on data file
-> 12 Sep 1995 : 001.003 :  Highlights current player's position
-> 20 Aug 1995 : 001.002 :  Updated to use krsnake.library
-> 27 Jun 1995 : 001.001 :  Initial release
->
-> NOVUS ORDO SECLORUM!
->

OPT OSVERSION=37

MODULE 'intuition/intuition','intuition/screens','dos/dos','graphics/text'
MODULE 'graphics/view','exec/ports','exec/lists','exec/nodes','utility'
MODULE 'reqtools','libraries/reqtools','krsnake','libraries/krsnake'
MODULE 'tools/trapguru','tools/exceptions','exec/tasks','*createpath'

RAISE   "SCR"   IF  LockPubScreen()=0,
        "WIN"   IF  OpenWindowTagList()=0,
        "DRI"   IF  GetScreenDrawInfo()=0,
        "FONT"  IF  OpenFont()=0,
        "LIB"   IF  OpenLibrary()=0

OBJECT playernode
    succ:PTR TO playernode
    pred:PTR TO playernode
    name:PTR TO CHAR
    score:LONG
ENDOBJECT

DEF krc=0,w=0:PTR TO window,s=0:PTR TO screen
DEF dri=0:PTR TO drawinfo,font:PTR TO textfont,dripens[NUMDRIPENS]:ARRAY OF INT
DEF ww=160,wh=-1,iw,ih,fy,fh,wx=0,wy=-1,th
DEF killtask=FALSE
DEF pubscreen[128]:ARRAY OF CHAR
DEF hall=0:PTR TO playernode
DEF dn[256]:ARRAY OF CHAR,current=0:PTR TO playernode
DEF visible=0

PROC newplayer(name:PTR TO CHAR,score)
    DEF node:PTR TO playernode,nodename:PTR TO CHAR
    NEW node
    NEW nodename[StrLen(name)+1]
    node.name:=nodename
    copystring(nodename,name)
    node.score:=score
    insertplayer(node)
ENDPROC node

PROC deleteplayer(node:PTR TO playernode)
    DEF nodename:PTR TO CHAR
    removeplayer(node)
    nodename:=node.name
    END nodename
    END node
ENDPROC

PROC removeplayer(node:PTR TO playernode)
    IF node.succ THEN node.succ::playernode.pred:=node.pred
    IF node.pred THEN node.pred::playernode.succ:=node.succ
    IF hall=node THEN hall:=node.succ
ENDPROC

PROC findplayer(name:PTR TO CHAR)
    DEF node:PTR TO playernode
    node:=hall
    WHILE node
        IF Stricmp(node.name,name)=0 THEN RETURN node
        node:=node.succ
    ENDWHILE
    node:=0
ENDPROC node

PROC insertplayer(node:PTR TO playernode)
    DEF c:PTR TO playernode,ok=0
    c:=hall
    IF c=0
        node.succ:=0
        node.pred:=0
        hall:=node
    ELSE
        WHILE ok=0
            IF node.score>=c.score
                node.pred:=c.pred
                node.succ:=c
                IF node.pred
                    node.pred::playernode.succ:=node
                ELSE
                    hall:=node
                    node.pred:=0
                ENDIF
                c.pred:=node
                ok:=1
            ELSE
                IF c.succ
                    c:=c.succ
                ELSE
                    c.succ:=node
                    node.pred:=c
                    node.succ:=0
                    ok:=1
                ENDIF
            ENDIF
        ENDWHILE
    ENDIF
ENDPROC

PROC getname(score)
    DEF node:PTR TO playernode
    RtGetStringA(dn,255,'Hall of Fame!',0,[RTGS_TEXTFMT,'Enter your name for the Hall of Fame:',RTGS_FLAGS,GSREQF_CENTERTEXT,NIL])
    IF (node:=findplayer(TrimStr(dn)))
        IF node.score<score
            newplayer(TrimStr(dn),score)
            deleteplayer(node)
        ENDIF
    ELSE
        newplayer(TrimStr(dn),score)
    ENDIF
    renderhall()
ENDPROC

PROC readhall() HANDLE
    DEF f=0,b[256]:ARRAY OF CHAR
    f:=Open('ENVARC:KRSNAke/HallOfFame.data',MODE_OLDFILE)
    IF f=0
        newplayer('Jacques de Molay',250)
        newplayer('Bernhard de Blanchefort',200)
        newplayer('Hugues de Payens',150)
        newplayer('Christian Rosenkreutz',100)
        newplayer('Charles XIII',50)
        Raise("URK")
    ENDIF
    WHILE TRUE
        readstring(f,b)
        rotstring(b)
        newplayer(b,readrotnumeral(f))
    ENDWHILE
EXCEPT DO
    IF f THEN Close(f)
ENDPROC

PROC dumphall() HANDLE
    DEF f=0,p:PTR TO playernode,b1[256]:STRING,b2[64]:STRING
    createPath('ENVARC:KRSNAke/urk')
    f:=Open('ENVARC:KRSNAke/HallOfFame.data',MODE_NEWFILE)
    IF f=0 THEN Raise("URK")
    p:=hall
    WHILE p
        IF Stricmp(p.name,'Player')
            StrCopy(b1,p.name)
            StringF(b2,'\d',p.score)
            rotstring(b1)
            rotstring(b2)
            VfPrintf(f,'%s\n%s\n',[b1,b2])
        ENDIF
        p:=p.succ
    ENDWHILE
EXCEPT DO
    IF f THEN Close(f)
ENDPROC

PROC dumpsettings() HANDLE
    DEF f=0
    createPath('ENVARC:KRSNAke/urk')
    f:=Open('ENVARC:KRSNAke/HallOfFame.snapshot',MODE_NEWFILE)
    IF f=0 THEN Raise("URK")
    VfPrintf(f,'%ld\n%ld\n%ld\n%ld\n%s\n',[wx,wy,ww,wh,dn])
EXCEPT DO
    IF f THEN Close(f)
ENDPROC

PROC readstring(f,s)
    DEF i,b[256]:ARRAY OF CHAR
    IF (Fgets(f,b,255)=0) THEN Raise("URK")
    copystring(s,b)
ENDPROC i

PROC copystring(s2,s1)
    MOVE.L  s1,A0
    MOVE.L  s2,A1
copyloop:
    MOVE.B  (A0)+,D0
    CMP.B   #32,D0
    BLT     terminate
    MOVE.B  D0,(A1)+
    BRA     copyloop
terminate:
    CLR.B   (A1)+
ENDPROC

PROC rotstring(s)
    MOVE.L  s,A0
rotloop:
    MOVE.B  (A0),D0
    BEQ     endofrot
    EORI.B  #15,D0
    MOVE.B  D0,(A0)+
    BRA     rotloop
endofrot:
ENDPROC

PROC readnumeral(f)
    DEF i,b[256]:ARRAY OF CHAR
    IF (Fgets(f,b,255)=0) THEN Raise("URK")
    i:=Val(b)
ENDPROC i

PROC readrotnumeral(f)
    DEF i,b[256]:ARRAY OF CHAR
    IF (Fgets(f,b,255)=0) THEN Raise("URK")
    rotstring(b)
    i:=Val(b)
ENDPROC i

PROC readsettings() HANDLE
    DEF f=0
    f:=Open('ENVARC:KRSNAke/HallOfFame.snapshot',MODE_OLDFILE)
    IF f=0 THEN Raise("URK")
    wx:=readnumeral(f)
    wy:=readnumeral(f)
    ww:=readnumeral(f)
    wh:=readnumeral(f)
    readstring(f,dn)
    Close(f)
    f:=Open('ENVARC:KRSNAke.prefs',MODE_OLDFILE)
    IF f=0 THEN Raise("URK")
    readstring(f,pubscreen)
EXCEPT DO
    IF f THEN Close(f)
ENDPROC

PROC bevelbox(x1,y1,x2,y2,dir=TRUE,bf=0)
    DEF shine,shadow
    IF dir
        shine:=dripens[SHINEPEN]
        shadow:=dripens[SHADOWPEN]
    ELSE
        shine:=dripens[SHADOWPEN]
        shadow:=dripens[SHINEPEN]
    ENDIF
    SetAPen(stdrast,shine)
    RectFill(stdrast,x1,y1,x1,y2)
    RectFill(stdrast,x1+1,y1,x2-1,y1)
    SetAPen(stdrast,shadow)
    RectFill(stdrast,x1+1,y2,x2,y2)
    RectFill(stdrast,x2,y1,x2,y2-1)
    IF bf
        SetAPen(stdrast,bf)
        RectFill(stdrast,x1+1,y1+1,x2-1,y2-1)
    ENDIF
ENDPROC

PROC renderhall(noclear=FALSE)
    DEF pc,ty,i=0,p:PTR TO playernode,tp,urk[32]:STRING
    IF noclear=FALSE
        SetAPen(stdrast,dripens[BACKGROUNDPEN])
        RectFill(stdrast,4,fy+4,iw-5,ih-5)
    ENDIF
    pc:=(fh-12)/th
    ty:=fy+6+(((fh-12)-(pc*th))/2)
    p:=hall
    tp:=ty+font.baseline
    WHILE p AND (i<pc)
        IF p=current
            SetAPen(stdrast,dripens[HIGHLIGHTTEXTPEN])
            p:=p.succ
        ELSE
            SetAPen(stdrast,dripens[TEXTPEN])
        ENDIF
        StringF(urk,'\d',p.score)
        Move(stdrast,8,tp)
        Text(stdrast,p.name,StrLen(p.name))
        Move(stdrast,iw-8-TextLength(stdrast,urk,StrLen(urk)),tp)
        Text(stdrast,urk,StrLen(urk))
        tp:=tp+th
        p:=p.succ
        IF p=current THEN IF p.succ=0 THEN RETURN
    ENDWHILE
ENDPROC

PROC render()
    iw:=w.width-w.borderleft-w.borderright
    ih:=w.height-w.bordertop-w.borderbottom
    fy:=th+6
    fh:=ih-fy

    SetRast(stdrast,dripens[BACKGROUNDPEN])
    bevelbox(0,0,iw-1,th+5)
    bevelbox(0,fy,iw-1,ih-1)
    bevelbox(3,fy+3,iw-4,ih-4,FALSE)
    SetAPen(stdrast,dripens[HIGHLIGHTTEXTPEN])
    Move(stdrast,8,font.baseline+3)
    Text(stdrast,'Player',6)
    Move(stdrast,iw-8-TextLength(stdrast,'Score',5),font.baseline+3)
    Text(stdrast,'Score',5)
    renderhall()
ENDPROC

PROC openKRSNAkeLib()
    DEF base=0
    base:=OldOpenLibrary('krsnake.library')
    IF base=0 THEN OldOpenLibrary('Libs/krsnake.library')
    IF base=0 THEN OldOpenLibrary('PROGDIR:Libs/krsnake.library')
    IF base=0 THEN OldOpenLibrary('/Libs/krsnake.library')
    IF base=0 THEN OldOpenLibrary('PROGDIR:/Libs/krsnake.library')
    IF base=0 THEN Raise("klib")
ENDPROC base

PROC appear()
    IF visible=0
        IF StrLen(pubscreen)
            s:=LockPubScreen(pubscreen)
        ELSE
            s:=LockPubScreen(NIL)
        ENDIF
        font:=OpenFont(s.font)
        dri:=GetScreenDrawInfo(s)
        dripens:=dri.pens
        th:=font.ysize
        IF wh=-1 THEN wh:=(th*13)+32
        IF wy=-1 THEN wy:=s.barheight+1
        w:=OpenWindowTagList(NIL,[WA_WIDTH,ww,WA_HEIGHT,wh,
                                  WA_LEFT,wx,WA_TOP,wy,
                                  WA_TITLE,'Hall of Fame v1.4',
                                  WA_SIZEGADGET,TRUE,
                                  WA_DRAGBAR,TRUE,
                                  WA_DEPTHGADGET,TRUE,
                                  WA_CLOSEGADGET,TRUE,
                                  WA_ACTIVATE,FALSE,
                                  WA_SMARTREFRESH,TRUE,
                                  WA_SIZEBBOTTOM,TRUE,
                                  WA_GIMMEZEROZERO,TRUE,
                                  WA_NEWLOOKMENUS,TRUE,
                                  WA_SCREENTITLE,'KRSNAke Hall of Fame v1.4',
                                  WA_AUTOADJUST,TRUE,
                                  WA_PUBSCREEN,s,
                                  WA_RMBTRAP,TRUE,
                                  WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR IDCMP_NEWSIZE OR IDCMP_RAWKEY,
                                  NIL])
        WindowLimits(w,w.borderleft+w.borderright+128,w.bordertop+w.borderbottom+(th*12),-1,-1)
        SetStdRast(w.rport)
        SetFont(stdrast,font)
        render()
        visible:=1
    ENDIF
ENDPROC

PROC vanish()
    IF visible
        wx:=w.leftedge;wy:=w.topedge;ww:=w.width;wh:=w.height
        IF w THEN CloseWindow(w)
        IF dri THEN FreeScreenDrawInfo(s,dri)
        IF font THEN CloseFont(font)
        IF s THEN UnlockPubScreen(NIL,s)
        w:=0;dri:=0;font:=0;s:=0;visible:=0
    ENDIF
ENDPROC

PROC main() HANDLE
    DEF sig,mask,icl,ico,msg:PTR TO intuimessage,postpone=0,fnord=0
    trapguru()
    krsnakebase:=openKRSNAkeLib()
    reqtoolsbase:=OpenLibrary('reqtools.library',38)
    utilitybase:=OpenLibrary('utility.library',37)
    copystring(pubscreen,'Workbench')
    copystring(dn,'Crassus')
    GetVar('USER',dn,255,NIL)
    readsettings()
    readhall()
    IF (krc:=KsRegisterClient())=0 THEN Throw("krsX",'Unable to locate KRSNAke!')

    REPEAT
        IF visible
            mask:=Shl(1,KsGetClientSig(krc)) OR Shl(1,w.userport::mp.sigbit)
        ELSE
            mask:=Shl(1,KsGetClientSig(krc))
        ENDIF
        sig:=Wait(mask)
        IF And(sig,Shl(1,KsGetClientSig(krc)))
            fnord:=0
            WHILE KsReadEvent(krc,{icl},{ico})
                SELECT icl
                    CASE SNAKE_NEWGAME
                        current:=newplayer('Player',0)
                        renderhall()
                    CASE SNAKE_NEWSCORE
                        postpone:=ico
                        fnord:=1
                    CASE SNAKE_QUIT
                        killtask:=TRUE
                    CASE SNAKE_GAMEOVER
                        deleteplayer(current)
                        current:=0
                        getname(ico)
                    CASE SNAKE_SHOWINTERFACE
                        appear()
                    CASE SNAKE_HIDEINTERFACE
                        vanish()
                ENDSELECT
            ENDWHILE
            IF fnord=0 AND postpone>0 AND current
                removeplayer(current)
                current.score:=postpone
                insertplayer(current)
                IF visible THEN renderhall(TRUE)
                postpone:=0
            ENDIF
        ELSEIF visible=1
            IF And(sig,Shl(1,w.userport::mp.sigbit))
                WHILE (msg:=GetMsg(w.userport))
                    icl:=msg.class
                    ico:=msg.code
                    ReplyMsg(msg)
                    SELECT icl
                        CASE IDCMP_CLOSEWINDOW
                            killtask:=TRUE
                        CASE IDCMP_REFRESHWINDOW
                            render()
                        CASE IDCMP_NEWSIZE
                            render()
                        CASE IDCMP_RAWKEY
                            IF ico=$45 THEN killtask:=TRUE
                    ENDSELECT
                ENDWHILE
            ENDIF
        ENDIF
    UNTIL killtask

    vanish()
    dumphall()
    dumpsettings()

EXCEPT DO
    IF krc THEN KsRemoveClient(krc)
    vanish()
    IF utilitybase THEN CloseLibrary(utilitybase)
    IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
    IF krsnakebase THEN CloseLibrary(krsnakebase)
    IF exception THEN report_exception()
ENDPROC

CHAR '$VER: HallOfFame 1.005 (22 Sep 1995) stable beta test version'