        @program        pcode,pname
        include         macros.h
pcode:
        jsr             flib[clr_scr]
        SetFont		#2
	WriteStr	#10,#10,#1,pname
	SetFont         #1
        WriteStr        #35,#40,#4,m1
        WriteStr        #35,#50,#4,m2
        WriteStr        #35,#60,#4,m3
	WriteStr	#25,#85,#4,copyr
	SetFont		#0
	WriteStr	#23,#95,#4,email
	WriteStr	#40,#110,#4,revised


menu:
        jsr             flib[idle_loop]
        cmp             #49,d0
        beq             lockcalc
	cmp             #50,d0
        beq             CPWord        
	cmp 		#264,d0
	beq		done
	cmp             #51,d0
        beq             done
        bra             menu

;*********************** CHANGE PASSWORD ***************************
CPWord:
        ; Get current password
        jsr             GetPassword
        cmp             #1,d0
        bne             pcode

        lea             pword(pc),a2
        move.b          #0,(a2)
        clr             d3
        SetFont         #2
GetNextKey:
        jsr             flib[clr_scr]
        WriteStr        #10,#10,#1,pname
        WriteStr        #10,#55,#1,npword
        WriteStr        #125,#55,#1,pword
        jsr             flib[idle_loop]
        cmp.b           #13,d0
        beq             pwordset
        cmp.b           #01,d0
        bne             next1
        cmp             #0,d3
        beq             GetNextKey
        move.b          #0,-(a2)
        sub.b           #1,d3
        bra             GetNextKey
next1:
        cmp.b           #07,d0
        bne             next3
        lea             pword(pc),a2
        move.b          #0,(a2)
        clr             d3
        bra             GetNextKey
next3:
        cmp             #10,d3
        beq             GetNextKey
        move.b          d0,(a2)+
        add.b           #1,d3
        move.b          #0,(a2)
        bra             GetNextKey
pwordset:
        cmp             #0,d3
        beq             GetNextKey
        move.b          #0,(a2)+
        lea             pwlen(pc),a1
        move.b          d3,(a1)
        bra             pcode

;********************** LOCK CALCULATOR **********************
lockcalc:
        jsr             flib[clr_scr]
        trap            #4
        jsr             GetPassword
        cmp             #1,d0
        bne             lockcalc
        bra             pcode
done:
        rts

;********************** GET PASSWORD *********************
GetPassword:
getpword:
        lea             temp1(pc),a3
        lea             temp2(pc),a4
        move.b          #0,(a3)
        clr.b           d3
        SetFont         #2
nextchar:
        jsr             flib[clr_scr]
        WriteStr        #10,#10,#1,pname
        WriteStr        #10,#55,#1,prompt
        WriteStr        #135,#55,#1,temp1

        jsr             flib[idle_loop]
        cmp.b           #13,d0
        beq             GPEnter
        cmp.b           #01,d0
        bne             next2
        cmp.b           #0,d3
        beq             nextchar
        move.b          #0,-(a3)
        move.b          #0,-(a4)
        sub.b           #1,d3
        bra             nextchar
next2:
        cmp.b           #07,d0
        bne             next4
        lea             temp1(pc),a3
        lea             temp2(pc),a4
        move.b          #0,(a3)
        clr.b           d3
        bra             nextchar
next4:
        cmp.b           #10,d3
        beq             nextchar
        add.b           #1,d3
        move.b          d0,(a4)+
        move.b          #42,(a3)+
        move.b          #0,(a3)
        bra             nextchar
GPEnter:
        cmp.b           pwlen(pc),d3
        bne             wrong
        lea             temp2(pc),a3
        lea             pword(pc),a4
        sub.b           #1,d3
checkpword:
        cmpm.b          (a4)+,(a3)+
        bne             wrong
        sub.b           #1,d3
        BPL             checkpword
;        DBRA            d3,checkpword
correct:
        move.l          #1,d0
        rts
wrong:
        clr.l           d0
        rts

temp1   dc.b    0,0,0,0,0,0,0,0,0,0,0
temp2   dc.b    0,0,0,0,0,0,0,0,0,0,0
pwlen   dc.b    5                       ; Length of Password
pword   dc.b    "fargo",0,0,0,0,0,0   ; Max Length = 10


m1 dc.b "[1] Enable Password Protect",0
m2 dc.b "[2] Change Password",0
m3 dc.b "[3] Return to Fargo Shell",0
copyr   dc.b    "by Samuel Stauffer [Descolada]",0
email   dc.b    "sam.stauffer@aquila.com or descolada@geocities.com",0
revised dc.b   "Revised by Stephen Grigg [grigg@juno.com]",0
npword  dc.b    "New Password:",0
prompt  dc.b    "Enter Password:",0
pname   dc.b "Password Protect Version 1.5",0

	reloc_open
	add_library	flib
        add_library     romlib
	reloc_close
	end
