HPHP48-R,*pÖ

INCLUDE APP.H
xROMID 838
xTITLE HW   Homework browser
xCONFIG HWCnfg

EXTERNAL xHWBR

EXTERNAL hwblnk

LABEL HWCnfg
::
 hwblnk
 ' ID HWdat
 SysSTO
 838 TOSRRP
;

NIBB 1 8
sNAME HWBR HWBR
::
 CK0
 ' ID HWdat @
 ITE
 ::
  XEQTYPE %26 %= NOT
  SWAPDROP
 ;
 TRUE
 IT
 ::
  hwblnk ' ID HWdat
  SysSTO
 ;
 ' ::
  #ZERO#ONE ONEONE
  {
   <SkipKey >SkipKey
   <DelKey >DelKey
   NullMenuKey TogInsertKey
  }
  ONEFALSE ZERO
  InputLine
 ;
 ' ::
  BRRclCurRow THREE #* #1-
  ' ::
   83 #=casedrop ::
    ChooseMenu0 TRUE
   ;
   DROPFALSE
  ;
  "WHICH HOMEWORK"
  SEVENTEEN
  {
   { "MOST RECENT" ONE }
   { "PREVIOUS" TWO }
  }
  ONE
  Choose
  NOT?SEMI
  TWO NTHCOMPDROP #+
  LAM ldat SWAP
  NTHCOMPDROP
  FIFTEEN FOUR
  MINUSONE
  ' MsgBoxMenu
  DoMsgBox DROP
 ;
 ID HWdat TOTEMPOB
CODE
	GOSBVL  =SAVPTR
	A=DAT1  A
	D1=A
	LA(5)   =DOLIST
	DAT1=A  A
	D1=D1+  5
	LA(5)   =DOBINT
	DAT1=A  A
	GOVLNG  =GETPTRLOOP
ENDCODE
 TWO NTHCOMPDROP
 ' ::
  838 LAM ldat
  TWO{}N TOTEMPOB DUP
  OCRC DROP FIVE #-
CODE
	GOSBVL  =POP#
	GOSBVL  =SAVPTR
	ABEX    A
	A=DAT1  A
	D1=A
	LA(5)   =DOEXT0
	DAT1=A  A
	D1=D1+  5
	A=B     A
	DAT1=A  A
	GOVLNG  =GETPTRLOOP
ENDCODE
  ' ID HWdat SysSTO
 ;
 { LAM NEHW LAM VIEWER
 LAM ldat LAM quit }
 BIND
 BEGIN
  ClrDA1IsStat RECLAIMDISP
  POLSaveUI
  ERRSET
  {
   { "RENM" ::
    TakeOver
    "Are you sure you want to rename your classes?"
    TWELVE THREE
    grobAlertIcon
    ' ::
     ' NullMenuKey DUPDUP DUP
     { "NO" ::
      TakeOver FalseTrue 2PUTLAM
     ; }
     { "YES" ::
      TakeOver TrueTrue 2PUTLAM
     ; }
     SIX {}N
    ;
    DoMsgBox
    NOT?SEMI
    "NUMBER:" ONE TWENTYEIGHT
    ' ::
     FORTYSIX #=casedrop ::
      DUP %10 %<
      SWAP %0> AND TRUE
     ;
     DROPFALSE
    ;
    THIRTYONE TWENTYSIX
    90 NINE ONE
    { ZERO } TWO
    NULL$ MINUSONE
    DUPDUP DUP
    ONEONE
    ' ::
     TWENTYEIGHT #=casedrop
     FalseTrue DROPFALSE
    ;
    "ENTER NUMBER OF CLASSES"
    DoInputForm
    DROP COERCE
    DUPDUP
    1LAMBIND
    #1+_ONE_DO
     "NAME" ONE TWENTYEIGHT
     'DROPFALSE
     TWENTYTHREE TWENTYSIX
     90 NINE ONE
     { TWO } TWO
     NULL$ MINUSONE
     DUPDUP DUP
     ONEONE
     ' ::
      TWENTYEIGHT #=casedrop
      FalseTrue DROPFALSE
     ;
     "NAME OF CLASS NUMBER "
     INDEX@ #>$ &$
     DoInputForm
     DROP
     "Empty"
     DUP
    LOOP
    1GETABND
    THREE #*
    #1+
    {}N ' LAM ldat STO
    FALSE BRdone
   ; }
   NullMenuKey
   { "VIEW" ::
    TakeOver
    LAM VIEWER EVAL
   ; }
   { "EDIT" ::
    TakeOver
    BRRclCurRow
    THREE #* DUP
    LAM ldat SWAP
    NTHCOMPDROP
    "Edit Homework"
    SWAP LAM NEHW EVAL
    ITE ::
     SWAP LAM ldat PUTLIST
     ' LAM ldat STO
    ;
    DROP
    FALSE BRdone
   ; }
   { "NEW" ::
    TakeOver
    BRRclCurRow THREE #* #1-
    "Enter New Homework"
    NULL$ LAM NEHW EVAL
    ITE ::
     DATE Date>d$
     NEWLINE$&$ SWAP&$
     SWAPDUP #1+
     LAM ldat SWAP
     NTHCOMPDROP OVER
     #2+ LAM ldat
     PUTLIST SWAP#1+
     SWAP PUTLIST
     ' LAM ldat STO
    ;
    DROP
    FALSE BRdone
   ; }
   { "QUIT" ::
    TakeOver
    LAM quit EVAL
    TRUE BRdone
   ; }
  }
  "HOMEWORK BROWSER"
  {
   ::
    LAM VIEWER EVAL
   ;
   ::
    LAM quit EVAL
    TRUE BRdone
   ;
  }
  ONEONE
  NULL{}
  ' ::
   SWAPDROP ZERO #=casedrop
   ::
    LAM ldat CARCOMP
   ;
   THREE #* #1-
   LAM ldat SWAP
   NTHCOMPDROP
  ;
  NULL{}
  BRbrowse
  ERRTRAP
  ::
   LAM quit EVAL
   POLResUI&Err
  ;
  POLRestoreUI
 UNTIL
 ABND
 ClrDAsOK
;

NULLNAME hwblnk
ASSEMBLE
	CON(5)  =DOEXT0
	REL(5)  end
	CON(5)  838
	CON(5)  =DOLIST
	CON(5)  =ONE
	CON(5)  =DOCSTR
	REL(5)  estr
	NIBASC  \Empty\
estr
	CON(5)  =DOCSTR
	REL(5)  e1
	NIBASC  \Empty\
e1
	CON(5)  =DOCSTR
	REL(5)  e2
	NIBASC  \Empty\
e2
	CON(5)  =SEMI
	CON(5)  =SEMI
end
RPL