' The Household Inventory Report Program
' --------------------------------------
' This is Program #2 of 3: :"HouseInvPrint" -reports
' Program #1 is the "HouseInv" (main) program
' Program #3 is the "HouseInvMaint" program
'
' Please do not modify the title screen in any way.
' January 1987
'
numbx=2:RecCnt=0:n=0:m=0:i=0:ErrSW=0:type=0:PageCnt=0:LineCnt=0
LoadSW=0:Limit=0:Ptr1=0:Ptr2=0:offset=0:lgth=0
A%=0:B%=0
NewSeq$="":OldSeq$="":Sep$="":x$=""
DIM bx(numbx-1,6),bxtxt$(numbx-1)
Logo80 3
BldGadgets numbx,bx(),bxtxt$()
' Help Gadgets
DATA  36,172,40,16,7,4,0,"More"
DATA 156,172,40,16,7,2,0," Ok"
HlpA%=0:HlpB%=1
COLOR Blu,Blk
LOCATE  9,39:PRINT"THE"
LOCATE 11,22:PRINT"H O U S E H O L D   I N V E N T O R Y"
LOCATE 13,38:PRINT"SYSTEM"
COLOR Mag,Blk
LOCATE 16,28:PRINT"P R I N T   R E P O R T S"
MENU 1,0,1,"Project:"
MENU 1,1,1,"Quit    "
MENU 2,0,1,"Help:"
MENU 2,1,1,"General    "
MENU 2,2,1,"Order Entry"
MENU 2,3,1,"By Room    "
MENU 2,4,1,"By Item    "
MENU 3,0,1,"Report:"
MENU 3,1,1,"Order Entry"
MENU 3,2,1,"By Room    "
MENU 3,3,1,"By Item    "
MENU 4,0,0,""
ON MENU GOSUB GetMenu
ON MOUSE GOSUB GetMouse
COLOR Yel,Blk:LOCATE 21,23
PRINT"Use Menus to select program function"
MENU ON
WaitHere:
MENU 2,0,1:MENU 3,0,1
m=0:i=0:WHILE m=0:SLEEP:WEND
MENU 2,0,0:MENU 3,0,0
ON m GOTO Quit,Help,Report

' Menu Event Routine
' ------------------
GetMenu:
m=MENU(0):i=MENU(1)
RETURN

' Mouse Event Routine
' -------------------
GetMouse:
GetGadget A%,B%,bx(),bxtxt$(),type
RETURN

' Wait for Mouse Click
' --------------------
WaitMouse:
MOUSE ON
type=0:WHILE type=0:SLEEP:WEND
MOUSE OFF
RETURN

' Open and Load Data File
' -----------------------
OpenAndLoad:
ON ERROR GOTO CountError
OPEN"HouseInv.Count" FOR INPUT AS #2
ON ERROR GOTO 0
INPUT #2,RecCnt
CLOSE #2
IF RecCnt=0 THEN OALXit
WINDOW 3,,(440,40)-(608,96),0,1
COLOR Blu,Yel:CLS
LOCATE 2,2:PRINT"Loading File..."
OPEN "R",#1,"HouseInv.Data",103
FIELD #1,1 AS FFlg$,10 AS d$(0),15 AS d$(1),8 AS d$(2),6 AS d$(3),6 AS d$(4),6 AS d$(5),15 AS d$(6),20 AS d$(7),8 AS d$(8),8 AS d$(9)
DIM Records$(RecCnt)
FOR n=1 TO RecCnt
  GET #1,n
  IF FFlg$="0" THEN Sep$=" " ELSE Sep$="*"
  Records$(n)=Sep$
  FOR m=0 TO 9
    Records$(n)=Records$(n)+d$(m)+Sep$
  NEXT
NEXT
CLOSE #1:LoadSW=1:ErrSW=0
WINDOW CLOSE 3
GOTO OALXit

CountError:
WINDOW 2
IF ERR=53 THEN
  LoadSW=0:ErrSW=1:RESUME OALXit
ELSE
  ON ERROR GOTO 0
END IF

OALXit:
RETURN

' Time to Quit and Return to Basic
' --------------------------------
Quit:
MENU OFF:MENU RESET
WINDOW CLOSE 2:SCREEN CLOSE 1
END

' Help Routines
' -------------
Help:
GOSUB DoHelp
GOTO WaitHere

' Generate Requested Report
' -------------------------
Report:
IF i=1 THEN NewSeq$="ASIS"
IF i=2 THEN NewSeq$="ROOM"
IF i=3 THEN NewSeq$="ITEM"
IF LoadSW=0 THEN GOSUB OpenAndLoad
IF ErrSW=1 OR RecCnt=0 THEN
  WINDOW 3,,(440,40)-(608,92),0,1
  COLOR Blu,Yel:CLS
  LOCATE 2,3:PRINT"File is  empty  or"
  LOCATE 3,3:PRINT"does not exist."
  LOCATE 5,3:PRINT"Press left  button"
  LOCATE 6,3:PRINT"to continue."
  WHILE MOUSE(0)=0:WEND
  WINDOW CLOSE 3
  GOTO RptXit
END IF
IF NewSeq$=OldSeq$ OR NewSeq$="ASIS" THEN DoPrint

' Looks Like We Have to Sort the File
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"Sorting File..."
OldSeq$=NewSeq$
Limit=1:WHILE Limit<=RecCnt:Limit=2*Limit:WEND
HalfIt:
Limit=INT(Limit/2)
IF Limit=0 THEN SortDone
FOR n=1 TO RecCnt-Limit
  Ptr1=n
  WHILE Ptr1>0
    Ptr2=Ptr1+Limit
    IF NewSeq$="ROOM" THEN offset=2:lgth=10
    IF NewSeq$="ITEM" THEN offset=13:lgth=15
    IF MID$(Records$(Ptr1),offset,lgth)>MID$(Records$(Ptr2),offset,lgth) THEN
      SWAP Records$(Ptr1),Records$(Ptr2)
      Ptr1=Ptr1-Limit
    ELSE
      Ptr1=0
    END IF
  WEND
NEXT
GOTO HalfIt
SortDone:
MENU 3,1,0
WINDOW CLOSE 3

' And Now to Print the Report
DoPrint:
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,4:PRINT"Now Printing..."
OPEN "PRT:" FOR OUTPUT AS #3
GOSUB PageHdg
FOR n=1 TO RecCnt
  IF LineCnt>55 THEN GOSUB NewPage:GOSUB PageHdg
  IF NewSeq$="ITEM" THEN
    x$=MID$(Records$(n),12,16)
    x$=x$+MID$(Records$(n),1,11)
    x$=x$+MID$(Records$(n),28,46)
  ELSE
    x$=MID$(Records$(n),1,73)
  END IF
  PRINT #3,"   "+x$
  PRINT #3,SPACE$(30)+MID$(Records$(n),74)
  LineCnt=LineCnt+2
NEXT
GOSUB NewPage:PageCnt=0:CLOSE #3
GOTO RptXit

NewPage:
PRINT #3,CHR$(12);
RETURN

PageHdg:
PRINT #3," ":PageCnt=PageCnt+1
PRINT #3,SPACE$(37);
PRINT #3,USING"-##";PageCnt;:PRINT #3,"-"
PRINT #3,SPACE$(8);
PRINT #3,CHR$(27)+"[6w";: 'Set Double width
PRINT #3,"The Household Inventory Program";
PRINT #3,CHR$(27)+"[5w": 'Set normal width
PRINT #3," "
IF NewSeq$="ITEM" THEN
  PRINT #3,"    Item==========> Room=====>";
ELSE
  PRINT #3,"    Room=====> Item==========>";
END IF
PRINT #3," Pur-Data OrCost CWorth RpCost Serial-Number=>"
PRINT #3,SPACE$(31)+"Comments===========> Add-Date Chg-Date"
PRINT #3,"    "+STRING$(72,"-")
LineCnt=9
RETURN

RptXit:
WINDOW CLOSE 3
GOTO WaitHere

' Help Routines (requested via Help Menu)
' ---------------------------------------
DoHelp:
WINDOW 4,,(408,0)-(631,186),0,1
COLOR Blu,Yel:CLS:LOCATE 2,1
ON i GOTO HlpGen,HlpASIS,HlpROOM,HlpITEM
HlpGen:
PRINT" 'HouseInvPrint'  uses   a"
PRINT" data   file  created   by"
PRINT" 'HouseInv'  as input  and"
PRINT" produces  three   reports"
PRINT" from   the  contents   of"
PRINT" that file.":PRINT" "
PRINT" A     third      program,"
PRINT" 'HouseInvMaint'  is  used"
PRINT" for functions related  to"
PRINT" the  maintenance  of  the"
PRINT" file itself, (rather than"
PRINT" the contents)."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpASIS:
PRINT" The report is produced in"
PRINT" the same sequence as that"
PRINT" in  which the items  were"
PRINT" entered.":PRINT" "
PRINT" This option is only valid"
PRINT" before  a report  of  any"
PRINT" other  sequence  is  pro-"
PRINT" duced.":PRINT" "
GOSUB HelpCommon
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpROOM:
PRINT" The  list  of  items   is"
PRINT" sorted into room sequence"
PRINT" before   the  report   is"
PRINT" printed.":PRINT" "
GOSUB HelpCommon:PRINT" "
PRINT" N.B.  An   'Order  Entry'"
PRINT" report   is   no   longer"
PRINT" available."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpITEM:
PRINT" The  list  of  items   is"
PRINT" sorted into item sequence"
PRINT" before   the  report   is"
PRINT" printed.":PRINT" "
GOSUB HelpCommon:PRINT" "
PRINT" N.B.  An   'Order  Entry'"
PRINT" report   is   no   longer"
PRINT" available."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HelpCommon:
PRINT" Items  which  have   been"
PRINT" deleted, but not yet  re-"
PRINT" moved   from  the   file,"
PRINT" (see    'HouseInvMaint'),"
PRINT" are  listed with  an  '*'"
PRINT" separating the pieces  of"
PRINT" information."
RETURN

HlpXit:
WINDOW CLOSE 4
RETURN

' Various Subprograms
' -------------------
SUB Logo80 (Depth%) STATIC
SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
IF First=0 THEN
  First=1
  SCREEN 1,640,200,Depth%,2
  WINDOW 2,,,16,1
  COLOR ,0:CLS
  PALETTE 0,0,0,0  :Blk=0:'Black
  PALETTE 1,0,0,1  :Blu=1:'Blue
  PALETTE 2,0,.75,0:Grn=2:'Green
  PALETTE 3,0,1,1  :Cyn=3:'Cyan
  PALETTE 4,1,0,0  :Red=4:'Red
  PALETTE 5,1,0,1  :Mag=5:'Magenta
  PALETTE 6,1,.8,0 :Yel=6:'Yellow
  PALETTE 7,1,1,1  :Wht=7:'White
END IF
COLOR ,Blk:CLS
AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
COLOR Blu:AREAFILL
AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
AREA STEP(-40,0):COLOR Grn:AREAFILL
AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
COLOR Red:AREAFILL
AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
AREA STEP(-20,0):COLOR Cyn:AREAFILL
AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
AREA STEP(-16,0):COLOR Mag:AREAFILL
AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
AREA STEP(-56,0):COLOR Yel:AREAFILL
COLOR Blu,Blk:LOCATE 24,7
PRINT"Bryan D. Catley  2221 Glasgow Road  Alexandria  Virginia  22307-1819";
END SUB

SUB BldGadgets (Num,t1(),t2$()) STATIC
FOR n=0 TO Num-1
  FOR m=0 TO 6
    READ t1(n,m)
  NEXT m
  READ t2$(n)
NEXT n
END SUB

SUB DrawGadgets (Ga%,Gb%,t1(),t2$()) STATIC
FOR n=Ga% TO Gb%
  x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
  bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
  LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
  IF bo>-1 THEN
    LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
    LINE(x2+1,y1+1)-(x2+1,y2+1),bo
    LINE(x2+1,y2+1)-(x1+1,y2+1),bo
    COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
    LOCATE row%,col%:PRINT t2$(n)
  END IF
NEXT n
END SUB

SUB GetGadget (Ga%,Gb%,t1(),t2$(),type) STATIC
SHARED MouseX%,mouseY%,MouseInd
WHILE MOUSE(0)=0:WEND
r%=CSRLIN:c%=POS(0)
mx=MOUSE(1):my=MOUSE(2)
MouseX%=mx:mouseY%=my:MouseInd=0
FOR n=Ga% TO Gb%
  IF mx>t1(n,0) AND mx<t1(n,0)+t1(n,2) THEN
    IF my>t1(n,1) AND my<t1(n,1)+t1(n,3) THEN
      bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
      IF bo>-1 THEN
        x1=t1(n,0)+2:y1=t1(n,1)+2
        x2=x1+t1(n,2)-4:y2=y1+t1(n,3)-4
        LINE(x1,y1)-(x2,y2),fg,bf
        COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
        LOCATE row%,col%:PRINT t2$(n)
      ELSE
        IF bo=-1 THEN
          x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
          LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
        END IF
      END IF
      type=n-Ga%+1:n=Gb%:MouseInd=1
      IF bo<-1 THEN 
        n%=type+Ga%-1:DrawGadgets n%,n%,t1(),t2$()
      END IF
    END IF
  END IF
NEXT n
WHILE MOUSE(0)<>0:WEND
LOCATE r%,c%
END SUB