; Keepout 2.3 by Tim Gerla
; (c) 1996 Tim Gerla
; See KEEPOUT.TXT for instructions
; BTW, my code is not too neat, read at your own risk! :-)

        @program        prog_code,prog_name
        include         macros.h
;************** Start of Fargo program **************

prog_code:
        jsr             flib[clr_scr]

        SetFont         #1
        WriteStr        #20,#10,#1,m1
        WriteStr        #20,#20,#1,m2
        WriteStr        #20,#30,#1,m3
        WriteStr        #20,#40,#1,m4
        WriteStr        #20,#50,#1,mo3
        WriteStr        #20,#60,#1,m5
        jsr             infostuff                
top:
        jsr             shutoff ;flib[idle_loop]
        cmp             #2000,d0
        beq             exit
        cmp             #268,d0
        beq             protect
        cmp             #269,d0
        beq             changword
        cmp             #270,d0
        beq             options
        cmp             #271,d0
        beq             exit
        cmp             #264,d0
        beq             exit
        cmp             #272,d0
        beq             about
        bra             top
exit:
        rts
        bra top
        
options:
        jsr             flib[clr_scr]

        SetFont         #1
        WriteStr        #20,#10,#1,mo1
        WriteStr        #20,#20,#1,mo2
        WriteStr        #20,#30,#1,mo3
        WriteStr        #20,#40,#1,mo4
        jsr             infostuff                
topo:
        jsr             flib[idle_loop]

        cmp             #268,d0
        beq             changname

        cmp             #269,d0
        beq             changewait

        cmp             #271,d0
        beq             prog_code
        cmp             #264,d0
        beq             prog_code
        bra             topo

;----------------change wait-----------------------
changewait:
        lea             wait(pc),a2
        clr             d3
        SetFont         #2
nextkey2w:
        jsr             flib[clr_scr]
        SetFont         #1
        WriteStr        #10,#10,#0,promptw
        WriteStr        #10,#20,#0,promptw1
        jsr             infostuff
        move            (a2),d5
        divs            #20,d5
keyget:    
        move.w          d5,d0
        move.l          #5,d1
        move.l          #10,d2
        move.l          #3,d4
        jsr             hexlib[put_hex]

        jsr             flib[idle_loop]

        cmp             #338,d0
        beq             up
        cmp             #344,d0
        beq             down
        cmp             #13,d0
        beq             donew
        cmp             #264,d0
        beq             donew
        bra             keyget

up:
        add             #1,d5
        bra             keyget
down:
        sub             #1,d5
        bra             keyget
donew:
        muls            #20,d5
        move            d5,(a2)
        bra             options



;-----------Protect-----------------------------------------
protect:
        jsr             flib[clr_scr]
        trap #4
        SetFont         #1
        WriteStr        #10,#10,#1,thisis
        SetFont         #2
        WriteStr        #95,#8,#1,yourname
        WriteStr        #10,#30,#0,prompt
        jsr             infostuff                
        jsr             GETPASSWORD
	rts
;-------------------Change password------------------
changword:
        jsr             flib[clr_scr]
        SetFont         #2
        WriteStr        #10,#10,#0,prompt
        jsr             infostuff                
        jsr             GETPASSWORD

        move            #0,d3
        lea             pword(pc),a2
        move.b          #0,(a2)
        clr             d3
        SetFont         #2
        jsr             flib[clr_scr]
        SetFont         #2
        WriteStr        #10,#10,#1,prompt
        WriteStr        #10,#20,#0,newpword
        jsr             infostuff                
nextkey:
        jsr             flib[idle_loop]
        jsr             starmaker        
        cmp.b           #13,d0
        beq             pwordset
        cmp.b           #01,d0
        bne             next1
        cmp             #0,d3
        beq             nextkey
        move.b          #0,-(a2)
        sub.b           #1,d3
        bra             nextkey
next1:
        cmp             #10,d3
        beq             nextkey
        move.b          d0,(a2)+
        add.b           #1,d3
        move.b          #0,(a2)
        bra             nextkey
pwordset:
        cmp             #0,d3
        beq             nextkey
        move.b          #0,(a2)+
        sub.b           #1,d3
        lea             length(pc),a1
        move.b          d3,(a1)
        jsr             flib[clr_scr]
        jsr             starclear        
        bra             prog_code
        



;-----------get password-----------------------------
GETPASSWORD:
getkeyw1:
        move.b          length(pc),d1
        lea             pword(pc),a1
nextkey11:
        jsr             flib[idle_loop]
        jsr             starmaker
        move.b          (a1)+,d2
        cmp.b           d0,d2
        bne             getkeyw1
        DBGT.b          d1,nextkey11
        bra             correct

correct:
        jsr             starclear
        rts
;-----------change name------------------------------
changname:
        lea             yourname(pc),a2
        move.b          #0,(a2)
        clr             d3
        SetFont         #2
nextkey2:
        jsr             flib[clr_scr]
        SetFont         #2
        WriteStr        #10,#10,#0,entername
        SetFont         #1
        WriteStr        #10,#25,#1,max
        SetFont         #2
        WriteStr        #10,#50,#1,yourname
        jsr             infostuff
        jsr             flib[idle_loop]

        cmp.b           #13,d0
        beq             nameset
        cmp.b           #257,d0
        beq             nextkey2
        cmp.b           #01,d0
        bne             next2
        cmp             #0,d3
        beq             nextkey2
        move.b          #0,-(a2)

        bra             nextkey2
next2:
        cmp             #18,d3
        beq             nameset ;nextkey2
        move.b          d0,(a2)+
        add.b           #1,d3
        move.b          #0,(a2)
        bra             nextkey2
nameset:
        cmp             #0,d3
        beq             nextkey2
        move.b          #0,(a2)+
        sub.b           #1,d3
        lea             nlength(pc),a1
        move.b          d3,(a1)
        jsr             flib[clr_scr]
        bra             options

;-------------------------
infostuff:
        SetFont         #1
        WriteStr        #20,#104,#1,prog_name
        rts

;-------------------------
about:
        jsr             flib[clr_scr]

        SetFont         #2
        WriteStr        #10,#10,#1,prog_name
        WriteStr        #10,#22,#1,info
        WriteStr        #10,#32,#1,email
        SetFont         #0
        WriteStr        #10,#52,#1,web
        SetFont         #1
        WriteStr        #10,#62,#1,thanks1
        WriteStr        #10,#72,#1,thanks2

        jsr             flib[idle_loop]
        bra             prog_code

;-----------shutoff--------------------

shutoff:
	movem.l	a0-a6/d1-d7,-(a7)

idle_start:
        lea     wait(pc),a2
        move    (a2),d4
        move.l  d4,APD_TIMER        ; reset APD timer (1)
	clr.w	APD_FLAG		; reset APD timer (2)
	move.w	#ACTIVITY_IDLE,-(a7)
        jsr     romlib[set_activity]
	add.l	#2,a7
wait_idle:
	stop	#$2000
	tst.w	APD_FLAG		; time for APD?
	beq	no_apd			; no -- do not shut down
do_apd:
        jsr     protect
        bra     yes_off

no_apd:
; input:  D0.L = long word
;         D1.L = row
;         D2.L = column
;         D4.L = no. of digits - 1

        move.l  APD_TIMER,d0
        move.l  #13,d1
        move.l  #25,d2
        move.l  #3,d4
        jsr     hexlib[put_hex]


	tst.w	($75B0)			; has a key been pressed?
	beq	wait_idle
        move.l  #$1770,APD_TIMER        ; reset APD timer (1)
	move.w	($75B2),d0
	clr.w	($75B0)			; clear key buffer

	move.l	d0,-(a7)
	move.w	#ACTIVITY_BUSY,-(a7)
	jsr	romlib[set_activity]
	add.l	#2,a7
	move.l	(a7)+,d0

try_key_off:
	cmp.w	#$210B,d0
	bne	not_key_off
	bra	do_apd
not_key_off:

	movem.l	(a7)+,a0-a6/d1-d7
        rts
yes_off:
	movem.l	(a7)+,a0-a6/d1-d7
        move    #2000,d0
        rts




;----------------------star maker-----------

starmaker:
        movem.l         a0-a6/d0-d7,-(a7)
        lea             POS(pc),a2
        add.w           #10,(a2)                 ;Increase X coordinate
        WriteStr        (a2),#60,#1,star
        movem.l         (a7)+,a0-a6/d0-d7
        rts
starclear:
        movem.l         a0-a6/d0-d7,-(a7)
        lea             POS(pc),a2
        clr.w           (a2)                 ;clear pos
        movem.l         (a7)+,a0-a6/d0-d7
        rts

;**************************************************

prog_name:
                dc.b    "Keepout 2.3",0
prompt          dc.b    "Please enter password:",0
promptw         dc.b    "Press [UP] and [DOWN] to change time",0
promptw1        dc.b    "(Very) Approximate Seconds",0
entername       dc.b    "Please enter your name:",0
max             dc.b    "(Max 18 characters)",0
info            dc.b    "By Tim Gerla aka. Tyball",0
email           dc.b    "timg@climax.polaristel.net",0
web             dc.b    "http://www.geocities.com/SiliconValley/Park/1691/",0
thanks1          dc.b    "Thanks to that1guy@juno.com",0
thanks2          dc.b    "for many great suggestions!",0

m1              dc.b    "(F1) - Protect Calculator",0
m2              dc.b    "(F2) - Change Password",0   
m3              dc.b    "(F3) - Options",0           
m4              dc.b    "(F4) - Exit",0              
m5              dc.b    "(F5) - About KeepOut 2.3",0

mo1             dc.b    "(F1) - Personalize Password Screen",0
mo2             dc.b    "(F2) - Change Timeout Value",0       
mo3             dc.b    "----------------------------------",0
mo4             dc.b    "(F4) - Exit",0                       

newpword        dc.b    "Please enter new password:",0
length          dc.b    3
pword           dc.b    "timg",0,0,0,0,0,0,0 
yourname        dc.b    "Tim Gerla",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
nlength         dc.b    8
thisis          dc.b    "Protected for",0
star            dc.b    "*",0
POS             dc.w    0
wait            dc.w    112

;************** End of Fargo program ****************

        reloc_open
        add_library     flib
        add_library     romlib
        add_library     hexlib
        reloc_close
        end