Calendar

Developer(s): Fred Nachbaur
Date: 1987
Type: Cassette
Platform(s): TS 1000
Tags: Calendar

Calendar is a year-at-a-glance appointment manager that calculates and displays a full 12-month calendar on a single screen. The program uses machine code routines (accessed via USR calls at addresses such as 20726, 20854, 19400, and 20820–20821) to handle keyboard input, screen output, cursor control, and data lookup within the appointment database. The calendar data is stored in a packed string array (I$), where each appointment entry is prefixed by month, day, and message-count bytes encoded using CHR$. Users can navigate the calendar with cursor keys, add or delete appointment messages for any date, browse all stored entries sequentially, and save or load the appointment data to tape. A leap year calculation at line 660 correctly handles the Gregorian 100-year and 1000-year exceptions, and the first-day-of-week offset is computed at lines 670–680 to correctly align January 1 for any year from 1800 to 2099.

Program Analysis

Program Structure

The program is organized into clearly labeled REM-delimited sections. The main flow begins at line 300 (jumped to via GOTO VAL "300" at line 8) and proceeds through initialization, calendar construction, display, and an interactive service loop. Key subroutine blocks are:

  • Lines 20–36: GOSUB 20 — compute array row/column position from month number
  • Lines 40–43: GOSUB 40 — reverse-decode month and day from screen coordinates
  • Lines 45–57: GOSUB 45 — text input routine using machine code keyboard handler
  • Lines 60–90: GOSUB 60 — print month labels onto the screen array
  • Lines 100–115: GOSUB 100 — print year label
  • Lines 120–135: GOSUB 120 — “abort?” confirmation prompt
  • Lines 170–210: GOSUB 170 — print appointment data for a date
  • Lines 300–999: initialization, calendar build loop
  • Lines 1000–1177: calendar display and cursor navigation loop
  • Lines 2000–2670: date selection and appointment service menu
  • Lines 3000–3530: delete one or all messages
  • Lines 4000–4160: browse entire appointment database
  • Lines 5000–5030: partial screen copy to printer
  • Lines 7000–7030: exit/quit
  • Lines 8000–8120: save/load data to tape
  • Lines 9000–9050: cover screen subroutine

Machine Code Usage

The program makes extensive use of USR calls to machine code routines embedded in the REM statements at lines 0–5. The primary addresses are:

AddressPurpose
19400 (HR)Display/hardware detection flag — used as a Boolean guard before every PRINT, CLS, LPRINT, etc.
20726Low-level keyboard scan returning key code in Z (used in the text input subroutine at line 48)
20820–20821POKEd with day and month before calling the data lookup routine
20854Returns a pointer (PD) into the appointment string I$ for the given date; returns 0 if no entry exists

The variable HR (set to 19400 at line 310) is used as both the machine code address and as a large PAUSE value (e.g., PAUSE HR at line 125), creating a “wait for keypress” idiom. Every display operation is guarded by IF USR HR THEN, making the program runnable in headless (non-display) mode by having the machine code at address 19400 return 0.

The LPRINT statements at lines 47, 49, 1050, and 1092 (using SP and SE) are directed at a hardware cursor controller rather than a printer — these set the cursor position and appear to be commands to an external display device, consistent with the TS2068 or a modified system using hardware-assisted display output.

Variable Initialization Idioms

Lines 301–306 initialize small integer constants using Boolean arithmetic rather than literal values, a classic memory-saving technique:

  • O = NOT PI → 0 (since PI is non-zero, NOT PI = 0)
  • I = NOT O → 1
  • U = I+I → 2
  • A = U+I → 3
  • E = VAL "8" → 8
  • Y = VAL "12" → 12
  • CAL = VAL "1000" → 1000 (used as a GOTO target)

Using VAL "number" for GOTO and GOSUB targets (e.g., GOTO VAL "300", GOTO CAL) is a standard memory optimization, storing the number as a short string rather than a five-byte floating-point value.

Calendar Layout Algorithm

The screen is represented as a 2D string array S$(24,64) (24 rows × 64 columns), initialized with separator characters at lines 710–760. The layout places up to 4 months across per row-group, using the subroutine at line 20 to map month number to a row/column origin. The day-of-week header “S–M–T–W–T–F–S-” is written directly into the array at line 830, and individual date numbers are packed in two columns (right-justified) within 3-column slots, with the column pointer C advancing by A (3) each day and wrapping with a row increment.

The first day of week (SD) is calculated at lines 670–680 using an integer arithmetic formula covering the full range 1800–2099, including the Gregorian correction for century years (-INT((YR-I)/100)) and the Y2K adjustment (+(YR>2000)). Leap year detection at line 660 correctly handles the century-year exception (divisible by 100 but not 1000 is not a leap year).

Appointment Data Storage

All appointment data is stored in a single string variable I$, initialized to CHR$ 255 as a sentinel. Each date record begins with a month byte, day byte, and message-count byte, followed by individual messages each prefixed by their length byte. The machine code at address 20854 performs the search given a month/day POKEd at 20820–20821, returning a pointer into I$.

Adding a message (lines 2500–2670) prepends or inserts into I$ using string slicing. Deleting a single message (lines 3000–3220) walks the packed structure to find the correct offset and excises it. Deleting all messages for a date (lines 3500–3530) removes the entire date block. The browse mode (lines 4000–4160) iterates through all records sequentially using the pointer PD.

Navigation and Key Codes

Cursor navigation in the calendar loop (lines 1040–1145) uses raw key codes from CODE INKEY$:

Code (Z)KeyAction
36right arrowCC += 3
33left arrowCC -= 3
34down arrowCR += 1
35up arrowCR -= 1
55‘7’ / RANDRAND 31 (re-seed)
63‘?’ / COPYscreen print
53‘5’redraw calendar
118ENTER/NEWLINEselect date / confirm
50‘2’ / Mshow month labels
62‘>’ / Dshow day labels
45‘-‘restore cursor to home
216set cursor homesave current position as home

Partial Screen Print

The subroutine at lines 5000–5030 uses POKE VAL "17692" to temporarily alter a system variable controlling the bottom of the print area, enabling a partial screen copy to the printer showing only the relevant portion of the display. The value is restored to 192 afterward.

Notable Anomalies

  • Line 8065 has a likely typo: IF T$="L" THEN LOAD T$ should be IF Z$="L" — the load branch will never trigger correctly as written.
  • Lines 8050 and 8060 are REMmed-out fast tape save/load variants, with instructions in the REM text to un-REM them and delete lines 8055/8065 to enable faster tape I/O.
  • The GOTO (expression) construct at line 2450 uses arithmetic on Boolean values to select a destination line number — a well-known Sinclair BASIC technique for computed GOTOs.
  • Line 812 contains IF USR HR THEN RUN inside the calendar build loop, which on a real machine would restart the program; this is presumably guarded by the HR machine code returning 0 during building, making it a no-op in practice.

Content

Appears On

Related Products

Year-at-a-Glance calculates any year between 1800-2099, showing the whole year on a single screen. Press “M” to give the month...

Related Articles

Related Content

Image Gallery

Source Code

   0 REM [C]█[1][9][8][7]█[S][M][C]##▘ ""LN  RUN ##[P]#Y2 GOSUB #<>5▟▝TAN  PRINT # RETURN,C▌LN [*]RNDINT / LET TAN 6-RNDLN #? FASTLN LN + LPRINT TAN LN [H]RND PRINT LN [4]RND7LN [H]RND# LET #TAN 7# RETURN#C▀ RETURN;""6-RNDTAN A ##▞▌ACS 9ACS =( IF ,,▘ 4,,TAN 7LN [T]RNDLN [4]RNDLN ,,INKEY$ ##ACS ZACS ZACS Z##STR$ LN STR$ RND LET J NEW▛W#TAN Y3[)]K▌LN [*]RNDINT (Y[Z][(]SQR LN [*]RNDINT 25  6AT ZA4##<▘ COPY*Q  GOSUB [K]TAN  NEXT Y▞# ( CLEARLEN  LIST W4 CLEAR▞"" CLEARACS ##C▝▞[K])4 5 4##INKEY$   ▌ASN #INKEY$ ;# GOSUB #### FOR E£RND ###) RUN ▙;Y2 GOSUB #Y PRINT ▘▛▝ CLEARACS ##CODE [P]▝LN [>]▝LN 4▝<>5GINKEY$ #[8]▝ CLEARACS #▚/▖ CLEARACS #LEN E£RND▘9  GOSUB PIF FOR 5 █;6#INKEY$  FOR  GOSUB [K]LN F?<>5GINKEY$ TAN 7LN [T]RNDLN [4]RND##LN ▞INKEY$ VAL 7LN [H]RNDAT LN STR$ RND#TAN 2 COPY/▝2 STR$ 7LN [T]RNDLN ,,INKEY$ SGN  GOSUB ##ZLN  LET RND##?( CLEARACS .*PI▌4▝▞▒▛( CLEAR#TAN Y COPY/▘[J]MVAL Z CLEARACS #[:]7LN [T]RNDLN ,,INKEY$ # RETURN,4"7 GOSUB ##ZLN [T]RNDLN ,,INKEY$ ## GOSUB ##ZVAL #[)]-▘K▖ GOSUB #- COPY4▝-  FAST##MSQR Z LET [(]2▘K▖ GOSUB #2 COPY4▝2 ##MINT Z#[W]S▞##- /▝2  GOSUB #SGN Z6PEEK Z#[B]3#A 6STR$ ZAT VAL Y[Z][(] PRINT UVAL Z# LET  CLEARACS ##4▌LN SGN INKEY$ /▀LN ##UPEEK Z#▞ USTR$ Z##,,#MSTR$ Z GOSUB #SGN ZUUSR Z# GOSUB PIS▒#MSTR$ Z GOSUB #INT ZAT #▙##▄#5CHR$ ZOUUSR Z[Y]4[N] GOSUB ##ZTAN Y COPY/▘[J]MVAL Z7LN [T]RNDLN [4]RNDVAL 7LN [H]RND#I 6INT Z#6SGN ZAT Y▘ PRINT VAL VAL EINT Z GOSUB #SGN Z▞▌VAL ACS EACS .( IF [R] GOSUB #6INT Z GOSUB #SGN ZAT ACS GACS 1( IF ;6SGN Z GOSUB #INT ZAT #ACS <[~~]##ACS +[£]#Y[Z][(]S,, PRINT UVAL Z# LET LN SGN INKEY$ AT  LET W RETURNASN S[O]TAN Y▘MINT ZLN COS RNDCOS LN [H]RNDMINT ZLN TAN RNDCOS 7LN [T]RNDLN [4]RND[S]S▀#INKEY$ #LN (INKEY$ #INKEY$ LN (INKEY$ #PI GOSUB #SQR Z[)]W PRINT 7LN [T]RND[S]K▀#INKEY$ # GOSUB #ABS Z[(]W4▘XSGN # GOSUB #USR ZUPEEK Z#USGN Z#[B]LN  INPUT RND6CHR$ ZUABS Z#USGN Z#[B]LN  INPUT RND6**Z£TAN LN +#4*UINT Z#5 4▘ /#J#7"#[L]4 RUN +4 INPUT TAN USTR$ ZECHR$ Z GOSUB #**Z6 AND Z GOSUB #>=Z PRINT  FAST GOSUB # LPRINT C#UPEEK ZLN  INKEY$ STR$ VAL #3ZACS <( IF AT ACS .*( CLS#SGN 7 FAST[B] GOSUB # LPRINT C▌#J#/ NEXT UABS ZLN  INKEY$ Y,,[(]#VAL ,*ZACS 1( IF AT ACS +3( CLS>▘4 E>=Z,,6>=Z FOR E AND Z,,6 AND Z LET X4[A]5INT ZP4[?]TAN UUSR Z RETURN▒4▖,J/NOT UPEEK ZLN  INKEY$ VAL ,3ZACS +( IF AT ACS 1*( CLS#UABS ZJ NEW▛C$#,VAL ?ACS 0( CLSAT ACS ▖( UNPLOT #/[E]E(RND#[T]COS  RETURN█4▌LN [*]RNDINT ▘VAL LN  PAUSE ,,AT  FOR / GOTO  PRINT  SCROLL FAST:RND▟#LN ##7 FAST▞▌[J]#( CLEARSGN  LPRINT  LET TAN LN  SCROLLRND#?( CLEARLN ##K▀Y▟>LN COS RNDTAB SQR #TAN LN  SCROLLRND FASTAT LN 4+ FASTLN ##AT  FAST##LN  PLOT ;LN [~~]+ LPRINT / STEP LN  SCROLLRND#▞ / SLOW###Y[Z][(]STR$ VAL  PRINT LN SGN INKEY$  LET AT SGN TAN 2 COPY/▝2 STR$ LN C#SGN USTR$ Z#UPEEK Z5SGN Z PRINT  FASTLN [D]#+C▞WLN [J]#/ RUN UUSR Z# LPRINT  LET F FASTLN [D]#+C▞£LN [J]#/ RUN USTR$ Z# LPRINT UABS Z PRINT  FASTLN [D]#+C▞XLN [J]#/ RUN UUSR Z# LPRINT  LET 7LN [D]#+COS $LN [J]#/ SAVE LN 7?2"" CLEARACS ##C▝2[K]5 4[J]PEEK  CLSLN #?ABS ▐▒<= CLS*K CLS-4▞▒#<= CLS3K CLS# NEW█PEEK  CLSACS )( PAUSE 7+4 FOR <= CLS3K CLSLN ##/SGN 76-RNDLN #?LN [B]:##▘▘COS  CLEARACS V#""( RAND $4 PLOT .#[N]4 INPUT TAN 7# RETURN#4,,LN  OR #LN  RUN #/L7# RETURN,C> RETURN;CG RETURN#C# RETURNAT C# RETURNTAB C#/# GOSUB #AT Z# NEW LIST LEN ( RETURNRNDCODE [O]#ATN [J]#/STR$ #LEN ▒#[J]# GOSUB #AT ZTAN ▞ COPY7# RETURN#COS  RETURN,4▖Y▖/" RETURN;4VAL ▖# RETURN▀ASN SQR #M""Z/ STOP GOSUB #AT Z/SQR 7LN [T]RND## RETURN[T]ABS =INKEY$ # RETURNRNDABS "INKEY$  GOSUB #AT Z/[?]7LN [H]RND NEWZ GOSUB #AT Z[T]#K GOTO Y▒█#/ NEW6-RNDLN #? FAST CLEARACS ▘#CODE STR$ .LN  SAVE < LPRINT  FAST#[L]C£,VAL STR$ LN K#SGN AT <"/ LIST  LPRINT /CODE  RETURN""4▖Y"/U PRINT  NEW# RETURNRNDK▛ LET  CLEARACS ▘LEN /G CLEARACS ▘#C~~[J] CLEARACS ▘▚LN ##/▖ CLEARACS ▘LEN  LET LN #,,~~ PRINT VAL  NEW#LN ##AT ▀ LET  RETURN█S LET  CLEARACS ▘▚[J] GOSUB #AT Z PRINT YZ[)]>=[J]#LN  RUN # LET VAL M<=Z[B]*[B]**- ACS >#5 2; FASTACS TLN STR$ RNDSGN U""Z RETURN▖ASN [=]# RETURN▝C# RETURN▘CFY▒ PRINT STR$ , PRINT U""Z[B]4"U<=ZACS #C▖ LET J/▘ LET #)4 ;SGN  LET <X4 TO AT ££ GOSUB #AT ZTAN U<=Z RETURNASEXP  RETURN[A]KASN  FAST5 2; FOR  LPRINT /AT U<=Z▛ FAST5 0S LET A,/ GOSUB  CLEARACS ##Y[S]C▝Y[C][S]SQR ## NEW▛▙#VAL ) 45 5ACS SACS SACS S# GOSUB [K]F#( UNPLOT AT TAN LN COS RNDY*C▀LN [H]RND)  WEAT Z FAST GOSUB #AT Z GOSUB #£RND< PRINT ▞4,VAL STR$ LN ##SGN AT <( PRINT  LET X4 GOSUB  LPRINT 6AT ZTAN LN COS RNDCATN LN [H]RNDW PRINT #Y""CHR$ ▒( UNPLOT ## LET /LEN 7LN [T]RNDLN ,,INKEY$ LN [4]RNDTAN Y COPY/▘[J]MVAL Z CLEARACS #[:]LN ## GOSUB #NOT ZE-RNDLN ## GOSUB # OR ZE-RND7LN [T]RNDLN ,,INKEY$  GOSUB #<=ZE#Z FAST GOSUB ##ZE OR Z FASTLN £PI LPRINT 6#ZENOT Z FASTLN £PI LPRINT 6#ZE<=ZLN £PI LPRINT 6#ZTAN LN +#4.UINT Z5 4##▘4 ,,▘ STEP * GOSUB [K]▞4F#( UNPLOT X4 DIM TAN USGN Z RETURN C##UPEEK Z#VAL Y[Z][(]VAL  PRINT WVAL LN  LET RNDSGN Y▒[S]4*UABS Z[<] RETURN▒S?#▘4  GOSUB PI# LET AT #LEN ▒#/ OR #?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT #▞ UABS Z##▀[B] GOSUB PIPIK[U]AT ▌USQR Z[S]4[L]USQR Z#EPEEK ZY COPY[W]4▘8# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT £ LPRINT 94 LIST 5INT ZP4▟TAN LN +#40UINT Z5 COPYR##▘4  GOSUB PI▘ STEP * GOSUB [S]▞47#( UNPLOT X4 CONT TAN USQR Z RETURN[Z]C##UPEEK Z#VAL Y[Z][(]VAL  PRINT XVAL LN  LET RNDSGN Y▒[S]4-UABS Z[<] RETURN▒S:#▘4 ,,# LET AT #LEN ▒#/ AND #?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT #▞ UABS Z##▀[B] GOSUB PIPIK[V]AT ▖USGN Z RETURN C▀[S]4[I]USGN Z#EPEEK ZY COPY[W]4▘8# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT £ LPRINT 94 LIST 5INT ZPTAB ▗#TAN LN +#4*UINT Z#5 COPYR▞4#[B]ACS -F( CLS[8]4 POKE 14 INPUT TAN USGN Z#UPEEK Z#VAL Y[Z][(]VAL  PRINT £LN  LET RND#?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT UABS Z£[T]4 STEP AT ▌# RETURN COPYC▒USQR Z##[U]KSQR  GOSUB #SGN Z#INKEY$ #USTR$ Z# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT ▌ LPRINT H4 LIST 5INT ZP4[B]TAN LN +#41UINT Z#5 4[B]▞4ACS 27( CLS▘ S[B] FAST GOSUB PI LPRINT 4 INPUT 14 CONT TAN USGN Z#UABS Z#VAL Y[Z][(]VAL  PRINT $LN  LET RNDY,,[(]##▛( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT UPEEK Z$[T]4>=AT ▌# RETURN COPYC▒USQR Z##[U]KATN USGN Z#UPEEK Z#USTR$ Z# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT ▌ LPRINT H4 LIST 5INT ZP4[6]TAN 7# RETURN0K▌LN [*]RNDINT 1 RETURNGK RUN CHR$ 0TAN LN ▝##ACS 4ACS 4ACS 4ACS 4LN ▝#█#7# RETURN"#TAN 7# RETURN"TAB SQR #7#ACS #C▝CHR$ RND)  77 FAST▞▒A # FOR ;( CLEAR FOR 5 S; FOR  LPRINT 7LN =#>4▌76-RNDTAN </ PAUSE 7LN [H]RND RETURN4) ▞SSTR$ LN [*]RNDINT .▘4 ,,# RETURNS**CHR$ /#TAN 7LN [H]RND RETURN4K SCROLLLN [4]RND[B]***- #5 Y;6**Z SCROLLLN [T]RND GOSUB # AND ZTAN LN ##Y[Z][(]K▝CHR$ RND##ACS WACS 1ACS WACS 1ACS WACS 1ACS  GOTO 6>=Z#J NEW▛WM#RND) STOPZ GOSUB #**ZY▒ PRINT #>~~VAL #U#RND RETURN▌S)JLEN ,,[B]##: C:3ACS ;( CLS/▛#[J]ACS )*( CLS[Q]#7<#>#[Q]#FLN ##<AT ▀ LET XTAB ACS #TAN LN COS RNDTAB SQR #E>=Z) STOPZ▞▒VAL ,#7<,#LN ##F<AT ( LET TAN  CLEARACS #EXP LN ##E-RND# RETURN,4$7 GOSUB ##Z FASTLN [4]# LPRINT LN [T]RND#~~PIVAL 5ORND##[S]C UNPLOT  CLEAR[-]#M#RNDLN £#AT LN [4]#U#RND CLEAR[Y]O4 CLSTAN LN COS RNDY C▀LN [H]RNDM#RNDTAN 1""AT Y▖PEEK  CLS0LN ###["]INKEY$  GOSUB ##INKEY$ <<7# RETURN#C*STR$ LN [H]RND#LN ▞INKEY$ ▖SGN ##ACS [W],LEN █>#<( POKE TAN ▞4[J]##ACS [W]>#<( RUN TAN  E-RND# RETURN;C# RETURN#C▌LN [*]RNDINT + LPRINT 6-RND▘  TAN E-RND# RETURN THENC▌LN [*]RNDINT ) FAST7#)""#STR$  RETURN LLIST ASN ## RETURN SCROLLASN [:]RND RETURN LOAD ASN B# RETURN LIST ASN 3# RETURN PAUSE ASN ## RETURN PRINT ASN ## RETURN PLOT ASN [Y]INKEY$  RETURN RUN ASN ▟INKEY$  RETURN SAVE ASN [~~]# RETURN RAND ASN ## RETURN CLSASN ;INKEY$  RETURN UNPLOT ASN TAB INKEY$  RETURN CLEARASN ▗INKEY$  RETURN RETURNASN [*]RND RETURN COPYASN /# RETURN LPRINT 4[9]SGN )[J]#STR$ 7# RETURNXC##7# RETURN#C[<] RETURN;4 PLOT # RETURNAASN [▒]# RETURNBASN [B]INKEY$  RETURNCASN [B]PI RETURNDASN  SCROLLINKEY$  RETURNIASN ## RETURNLASN [5]# RETURNPASN ## RETURNRASN [T]# RETURNS42F#7 RETURNDASN ## RETURNEASN ▞# RETURNMASN 8# RETURNPASN [1]# RETURNSASN ##/# RETURNTASN ## RETURNUASN F# RETURNW4UF#7 RETURNDASN ## RETURNLASN "# RETURNRASN ▟# RETURNUASN LEN #/57#7# RETURN#C; RETURN;4 PLOT # RETURNCASN [F]PI RETURNDASN  FOR INKEY$  RETURNRASN [X]# RETURNTASN ###SQR #
   1 REM  FAST##▞▛ACS 5>=?#USR  RETURN#Y▀X4 CLEAR GOSUB #▌TAB  LLIST #ACS 5>=?#USR  RETURN#TAN <= RETURNY,X4 CLEARPEEK  COPYY>X4 CLEAR#7##>#<= RETURNYDX4 CLEARPEEK  COPYY4X4 CLEARF7RTAN ▘ █VAL  LN  STEP #AT ▌TAB B#▀ GOSUB #LN  STEP #LN ##$LN  STEP # CLEAR FAST LET #:[E]LN  STEP #LN ###LN  STEP #LN ###LN  STEP # CLEAR FAST LET ##LN  STEP #7.#[N]4 PLOT   TAN LN  SCROLL▝76-RNDLN #? FASTLN  SAVE < LPRINT 7#[K]C: RETURN5K~~# RETURNSCOS  RETURNVCOS  RETURNPCOS INT 0LN ## PRINT ##VAL ) ▝LN ##SGN LN 8# LET E=RND RETURNS4▛5 4##/( RETURNP4▌),,RND/▖ GOSUB #(RND GOSUB # FOR LN 8##▛▝<= RETURN*S CLS: £<= RETURN*K IF #LEN  SCROLLACS <TAN 2 ▞▒LN ""#( CLSTAN - =PEEK  COPY# RETURNRNDK)2 LN ""#LN #?ABS [A]▀#[B]4 SCROLL/ SCROLL2 PEEK  COPYLN ""##[B]C PRINT LN PEEK #04CHR$ LN PEEK ## RETURN[E]4EXP LN PEEK ##LN PEEK #STR$ PEEK  COPYLN PEEK ##SGN 7.#[N]4 PAUSE TAN  FASTLN ## PRINT STR$ VAL 5WRND FASTLN <>#AT [J] GOSUB PIAT  GOSUB PISGN C,,-▝LN ## LET  LPRINT / TO 5WRND,[Y]4 LIST 7<"#[L]4 PRINT  LET  LPRINT  RETURNS4,,5 4LN <>##▛▝ RETURNV4>E(RNDLN <>#FLN [1]=SGN  LPRINT LN ▛▝##▞5,,RND/ GOTO 
   2 REM [6][4][-][C][O][L]█[P][R][I][N][T]## LIST  LIST  LIST  LIST  LIST  LIST  LIST  LIST WWWW LIST  LIST  LIST  LIST #### LIST  LIST  LIST  LIST ???? LIST  LIST  LIST  LIST  LIST  LIST  LIST  LIST WWWWWWWWWWWW####WWWW????WWWW#[9]#[9]#[9]#[9] LIST  LIST  LIST  LIST #[9]#[9]#[9]#[9] LIST  LIST  LIST  LIST  ##RND RNDRNDRND [4]E##[:][E]  ##[▒]#▙## RND8  ▖   ##PI# #  6##CODE #PI4 ▜PIPI#PI#█ ▒▖#[8]▒   ▝▖▒▖▝  LIST  ##RND#RND#  #USR [Y]▜#   #4I44#  E# INPUT #E   ▙▙##CC  RND[8]RNDRND#▖▒ RND█  ▖▖▒     £# (-,,,,0(█▜[£]▜▜▜[:]█ LIST ▖~~▝▖▒:  LIST [:]▙▜▙[~~]▜█ LIST >-,2>>(█[:][▒][£]▙[~~]▜ LIST (=/0,,= LIST █[:]PIPI8C/((=E8##▜█ ▖[~~] IF [A][6][8]  RND[8][6] NEW[E][A]  COS [C]ATN [E][E]ATN   #▜[~~][▒][▒]#  TAB [6][A][E][E]LEN    STEP ▜ASN [:][▒] NEW   LLIST ▜EXP ▜▜▜  RND[8][~~][E][A]#£ [C][C] GOTO [E][E][E]   SLOWRND### SLOW  #4A6[6]#▖ [C][C]ASN ATN [E][E]  ▜▜▜▜▜ LLIST   [4] REM  INPUT [I][E][E]  ""[G][E][E][E][E]  RND[8][E][E][E]#  ""[G][E]ASN [£][▒]▒ RND[A][E][E][A]PI7 ""[G][E]COS [C][C]  #▚#86ATN    SLOW####PI  [4][E][E][E][E]#  [4][E][E][E]##  [4][E][E][E] INPUT [E]  [4][E]##[E][E]  [4][E]##PIPI▖  STEP IPI#[▒] INPUT   FAST5[=]K; FOR  LPRINT U<=Z NEW█UAT Z?▞▒VAL  PRINT ,#CGS0 NEW LIST  PRINT # NEW?# LET [K]#<STR$ )4 ;SGN  LET AT ( STOPAT £ GOSUB #AT ZTAN ACS ZACS ZACS ZACS Z PRINT # NEW LIST />=S~~ACS BACS BACS BACS B/ATN  NEW?/ REM 
   3 REM [I][N][K][E][Y][$]##LN [V]▝##GC SAVE ACS #ACS "" PRINT LN [X]▛ LET #4▝LEN █[B]C4 RETURN#C0 RETURN█C8 RETURN[.]C7 RETURN[0]C7 RETURN.SPEEK  RETURNRNDS▒ RETURN[A]SACS  RETURN""KSIN #▞ VAL LN [V]▝G4 IF AT TAN [J]/ LET Y,/ GOSUB Y#/ DIM 
   4 REM [S][E][A][R][C][H]##▘▘YILEN 4# GOSUB #(RND FOR #[S]C$LEN █4▝INT ▘VAL LN  PAUSE ,,AT / INPUT 777TAN  LN ## FAST GOSUB #### RETURN COPYC07[S]4"#[T]4▛SGN [J] GOSUB ###TAN - 7#7#;X4 IF 7/ TO  LPRINT ▘  TAN      
   5 REM [Y][E][A][R][-][A][T][-][A][-][G][L][A][N][C][E]
   8 GOTO VAL "300"
  19 REM [G][E][T]█[A][R][R][A][Y]█[P][O][S]
  20 LET Q=INT (M/A-.2)
  25 LET MQ=M-A*Q-I
  30 LET R0=I+A*U*Q
  35 LET C0=U+21*MQ
  36 RETURN
  39 REM [G][E][T]█[D][A][T][E]█[I][N][F][O]
  40 LET MQ=INT (CC/21)
  41 LET Q=INT (CR/A/U)
  42 LET M=A*Q+MQ+I
  43 RETURN
  44 REM [I][N][P][U][T]█[T][$]
  45 LET T$=""
  46 LET L=LEN T$
  47 IF USR HR THEN LPRINT SP;I,4*L+4,184
  48 LET Z=USR 20726
  49 IF USR HR THEN LPRINT SE;
  50 IF Z=118 THEN RETURN
  51 IF Z=119 THEN GOTO 56
  52 IF L=62 THEN GOTO 47
  53 LET T$=T$+CHR$ Z
  54 IF USR HR THEN PRINT AT E,L+I;,CHR$ Z
  55 GOTO 46
  56 IF USR HR THEN PRINT AT E,L+I;" "
  57 LET T$=T$( TO L-I)
  58 GOTO 46
  60 REM [M][O][N][T][H]█[L][A][B][E][L][S]
  65 FOR M=I TO Y
  70 GOSUB 20
  75 IF USR HR THEN PRINT AT E*(R0-I),C0+E-I;,M$(M)
  80 NEXT M
  90 RETURN
  99 REM [Y][E][A][R]█[L][A][B][E][L]
 105 IF CC>52 THEN RETURN
 110 IF USR HR THEN PRINT AT E*CR,CC+A;;YR
 115 RETURN
 119 REM [A][B][O][R][T][?]
 120 IF USR HR THEN PRINT AT 184,O;,"[P][R][E][S][S] ""[E][N][T][E][R]"" [T][O] [D][E][L][E][T][E], [O][R] [A][N][Y] [O][T][H][E][R] [K][E][Y] [T][O] [A][B][O][R][T] [T][H][I][S] [C][O][M][M][A][N][D]"
 125 IF USR HR THEN PAUSE HR
 130 LET ABORT=(INKEY$ <>CHR$ 118)
 135 RETURN
 169 REM [P][R][I][N][T]█[D][A][T][A]
 170 LET NM=CODE I$(PD+U)
 175 IF USR HR THEN PRINT AT E*U,O;,
 180 LET P=A
 185 FOR N=I TO NM
 190 LET P1=P+CODE I$(PD+P)
 195 IF USR HR THEN PRINT TAB I;I$(PD+P+I TO PD+P1)
 200 LET P=P1+I
 205 NEXT N
 210 RETURN
 299 REM [P][R][O][G][R][A][M]█[S][T][A][R][T]
 300 FAST
 301 LET O=NOT PI
 302 LET I=NOT O
 303 LET U=I+I
 304 LET A=U+I
 305 LET E=VAL "8"
 306 LET Y=VAL "12"
 307 LET CAL=VAL "1000"
 310 LET HR=VAL "19400"
 315 IF USR HR THEN CLS
 320 IF USR HR THEN CLEAR
 330 IF USR HR THEN RAND 
 340 IF USR HR THEN RAND 31
 420 GOSUB 9000
 429 REM [I][$][=][D][A][T][A]
 430 LET I$=CHR$ 255
 440 LET N$="312831303130313130313031"
 449 REM [N][(][1][2][)][=][D][A][Y][S][/][M][O][N][T][H]
 450 DIM N(Y)
 460 FOR M=I TO Y
 470 LET N(M)=VAL N$(U*M-I TO U*M)
 480 NEXT M
 490 LET N$="[J][A][N][F][E][B][M][A][R][A][P][R][M][A][Y][J][U][N][J][U][L][A][U][G][S][E][P][O][C][T][N][O][V][D][E][C]"
 500 DIM M$(Y,A)
 510 FOR M=I TO Y
 520 LET M$(M)=N$(A*M-U TO A*M)
 530 NEXT M
 540 LET N$="  [S][U][N][D][A][Y]   [M][O][N][D][A][Y]  [T][U][E][S][D][A][Y] [W][E][D][N][E][S][D][A][Y] [T][H][U][R][S][D][A][Y]  [F][R][I][D][A][Y]  [S][A][T][U][R][D][A][Y]"
 550 DIM L$(7,A*A)
 560 FOR D=I TO 7
 570 LET L$(D)=N$(9*D-E TO 9*D)
 580 NEXT D
 590 DIM E$(32)
 600 IF USR HR THEN CLS
 610 IF USR HR THEN PRINT ;;"WHICH YEAR?",,;,"(1800-2099)"
 620 INPUT YR
 630 IF YR<VAL "1800" OR YR>VAL "2099" THEN GOTO 600
 640 IF USR HR THEN CLS
 650 IF USR HR THEN PRINT ;;"PLEASE STAND BY....."
 660 LET LP=(YR/4=INT (YR/4)) AND ((YR/100<>INT (YR/100)) OR (YR/1000=INT (YR/1000)))
 670 LET T=19+INT ((YR-I)/4)+INT (7*(YR/7-INT (YR/7))+I/U)-INT ((YR-I)/100)+(YR>2000)
 680 LET SD=T-7*INT ((T-I)/7)
 689 REM [S][$][(][2][4][,][6][4][)][=][S][C][R][E][E][N]█[A][R][R][A][Y]
 690 DIM S$(E*A,E*E)
 699 REM [F][I][L][L]
 700 IF LP THEN LET N(U)=29
 710 FOR M=I TO Y*U
 720 LET S$(M,I)="["]"
 730 FOR N=22 TO E*E STEP 21
 740 LET S$(M,N)="["]"
 750 NEXT N
 760 NEXT M
 770 LET CC=A*SD-U
 780 LET CR=I-(SD+N(I)>=37)
 785 LET HC=CC
 790 LET HRO=CR
 795 IF USR HR THEN PRINT ,,,,;;;"[W]ORKING [O]N:    ,";;YR
 800 FOR M=I TO Y
 810 IF USR HR THEN PRINT AT E*U,E*A;;;M$(M)
 812 IF USR HR THEN RUN 
 815 IF USR HR THEN PAUSE Y*Y
 817 FAST
 820 GOSUB 20
 830 LET S$(R0,C0 TO C0+20)="S--M--T--W--T--F--S-"
 840 LET C=A*SD-U
 850 LET R=R0
 860 IF SD+N(M)<37 THEN LET R=R+I
 870 FOR D=I TO N(M)
 880 LET D$=STR$ D
 890 LET LN=LEN D$-I
 900 LET CP=C0+C-LN
 910 LET S$(R,CP TO CP+LN)=D$
 920 LET SD=SD+I
 930 IF SD>7 THEN LET SD=SD-7
 940 LET C=C+A
 950 IF C<21 THEN GOTO 980
 960 LET C=C-21
 970 LET R=R+I
 980 NEXT D
 990 NEXT M
 1000 REM [C][A][L][E][N][D][A][R]
 1002 FAST
 1005 IF USR HR THEN CLS
 1010 FOR M=I TO Y*U
 1020 IF USR HR THEN PRINT ;,S$(M);
 1030 NEXT M
 1035 IF USR HR THEN RUN 
 1040 LET Z=CODE INKEY$ 
 1050 IF USR HR THEN LPRINT SP;O,CC*4,191-E*CR
 1080 LET CC=CC+A*(Z=36)-3*(Z=33)
 1090 LET CR=CR+(Z=34)-(Z=35)
 1092 IF USR HR THEN LPRINT SE;
 1095 IF CC>61 THEN LET CR=CR+I
 1100 IF CC<I THEN LET CR=CR-I
 1110 IF CR>23 THEN LET CR=O
 1115 IF CC>61 THEN LET CC=I
 1120 IF CC<I THEN LET CC=61
 1130 IF CR<O THEN LET CR=23
 1131 IF Z>32 AND Z<37 THEN GOTO 1040
 1132 IF Z=55 THEN IF USR HR THEN RAND 31
 1133 IF Z=63 THEN IF USR HR THEN COPY
 1134 IF Z=53 THEN GOTO 1000
 1135 IF Z=118 THEN GOTO 2000
 1137 IF Z=50 THEN GOSUB 60
 1138 IF Z=62 THEN GOSUB 100
 1139 IF Z=45 THEN GOSUB 1160
 1140 IF Z=216 THEN GOSUB 1170
 1145 GOTO 1040
 1155 RETURN
 1160 LET CC=HC
 1165 LET CR=HRO
 1167 RETURN
 1170 LET HC=CC
 1175 LET HRO=CR
 1177 RETURN
 1997 REM [S][E][R][V][I][C][E]
 1998 REM 
 1999 REM [G][E][T]█[D][A][T][E]
 2000 LET N$=S$(CR+I,CC+U)
 2010 IF N$<"0" OR N$>"9" THEN LET N$=" "
 2020 IF N$=" " THEN GOTO 4000
 2025 IF USR HR THEN PRINT AT E*CR,CC;"[▒][▒]"
 2030 LET D$=N$
 2040 LET N$=S$(CR+I,CC+I)
 2050 IF N$<"0" OR N$>"9" THEN LET N$=" "
 2060 LET D$=N$+D$
 2070 LET DN=VAL D$
 2080 LET DW=(CC-I)/A+I
 2090 IF DW<E THEN GOTO 2120
 2100 LET DW=DW-7
 2110 GOTO 2090
 2120 GOSUB 40
 2140 LET N$=L$(DW)+" "+M$(M)+" "+STR$ DN+", "+STR$ YR
 2150 IF USR HR THEN CLS
 2160 IF USR HR THEN PRINT AT O,E;;;N$
 2170 REM [P][D][=][D][A][T][E]█[P][O][I][N][T][E][R]
 2180 POKE 20820,DN
 2190 POKE 20821,M
 2200 LET PD=USR 20854
 2210 IF PD THEN GOTO 2280
 2220 IF USR HR THEN PRINT TAB A*U;;;"[N]OTHING SLATED FOR TODAY."
 2230 LET NM=O
 2240 LET SR=20
 2250 GOTO 2310
 2280 GOSUB 170
 2299 REM [S][E][R][V][I][C][E]█[L][O][O][P]
 2300 IF USR HR THEN PRINT AT 136,U;,"[C][O][P][Y] [T][O] [P][R][I][N][T][E][R]";TAB U;"[D][E][L][E][T][E] [A] [M][E][S][S][A][G][E]";TAB U;"[D][E][L][E][T][E] [A][L][L] [M][E][S][S][A][G][E][S]"
 2310 IF USR HR THEN PRINT AT 160,U;,"[A][D][D] [A] [M][E][S][S][A][G][E]";TAB U;"[S][A][V][E]/[L][O][A][D] [D][A][T][A]";TAB U;"[R][E][T][U][R][N] [T][O] [C][A][L][E][N][D][A][R]";TAB U;"[Q][U][I][T]"
 2320 LET MN=20-(A AND NM)
 2330 IF USR HR THEN PRINT AT E*SR,O;"=>"
 2340 IF USR HR THEN PAUSE U
 2350 IF USR HR THEN PRINT AT E*SR,O;"  "
 2370 LET SR=SR+(INKEY$ ="6")-(INKEY$ ="7")
 2380 IF SR>23 THEN LET SR=23
 2390 IF SR<MN THEN LET SR=MN
 2400 IF INKEY$ =CHR$ 118 THEN GOTO 2420
 2410 GOTO 2330
 2419 REM [O][P][T][I][O][N]█[S][E][L][E][C][T][E][D]
 2420 IF USR HR THEN PRINT AT E*SR,O;">>"
 2435 IF SR=17 THEN GOSUB 5000
 2440 IF SR=17 THEN GOTO 2330
 2450 GOTO (3000 AND SR=18)+(3500 AND SR=19)+(2500 AND SR=20)+(8000 AND SR=21)+(CAL AND SR=22)+(7000 AND SR=23)
 2499 REM [A][D][D]
 2500 IF USR HR THEN PRINT AT E,O;;E$;;AT E,I;
 2505 IF NM<14 THEN GOTO 2530
 2510 IF USR HR THEN PRINT ;;;"  [O]UT OF ROOM FOR THIS DAY"
 2515 IF USR HR THEN PAUSE Y*Y
 2520 IF USR HR THEN PRINT AT E,O;;E$;,
 2525 GOTO 2330
 2530 GOSUB 45
 2600 LET NM=NM+I
 2610 LET T$=CHR$ LEN T$+T$
 2620 IF NM>I THEN GOTO 2660
 2630 LET T$=CHR$ M+CHR$ DN+CHR$ I+T$
 2640 LET I$=T$+I$
 2650 GOTO 2150
 2660 LET I$=I$( TO PD+I)+CHR$ NM+T$+I$(PD+A TO )
 2670 GOTO 2150
 2999 REM [D][E][L][E][T][E]█[1]
 3000 IF NM=I THEN GOTO 3500
 3010 LET MN=I+NM
 3020 LET DR=U
 3030 IF USR HR THEN PRINT AT E*DR,O;,"(";TAB 63;")"
 3050 IF USR HR THEN PRINT AT E*DR,O;" ";TAB 63;" "
 3060 LET DR=DR+(INKEY$ ="6")-(INKEY$ ="7")
 3070 IF DR<U THEN LET DR=U
 3080 IF DR>MN THEN LET DR=MN
 3090 IF INKEY$ <>CHR$ 118 THEN GOTO 3030
 3100 IF USR HR THEN PRINT AT E*DR,O;"[*]";TAB 63;"[*]"
 3110 GOSUB 120
 3120 IF ABORT THEN GOTO 2150
 3130 LET P=A
 3140 FOR N=I TO DR-U
 3150 LET P1=P+CODE I$(PD+P)
 3160 LET P=P1+I
 3170 NEXT N
 3180 LET P1=PD+P
 3190 LET P=CODE I$(P1)
 3200 LET I$=I$( TO P1-I)+I$(P1+P+I TO )
 3210 LET I$(PD+U)=CHR$ (NM-I)
 3220 GOTO 2150
 3499 REM [D][E][L][E][T][E]█[A][L][L]
 3500 GOSUB 120
 3510 IF ABORT THEN GOTO 2150
 3520 LET I$=I$( TO PD-I)+I$(PD+P TO )
 3530 GOTO 2150
 3699 REM [P][R][I][N][T]█[F][I][L][E][S]
 4000 LET PD=I
 4010 LET M=CODE I$(PD)
 4020 IF USR HR THEN CLS
 4030 IF M<>255 THEN GOTO 4070
 4040 IF USR HR THEN PRINT AT E,20;;"END REACHED"
 4050 IF USR HR THEN PAUSE HR
 4060 GOTO CAL
 4070 LET DN=CODE I$(PD+I)
 4080 IF USR HR THEN PRINT AT E,10;;;M$(M);" ";DN;", ";YR
 4085 GOSUB 170
 4090 IF USR HR THEN PRINT AT 160,U;,"[Z]=[C][O][P][Y] [T][O] [P][R][I][N][T][E][R]";TAB U;"[Q]=[Q][U][I][T] [T][O] [C][A][L][E][N][D][A][R]";TAB U;"[E][N][T][E][R]=[V][I][E][W] [N][E][X][T] [F][I][L][E]"
 4100 IF USR HR THEN PAUSE HR
 4110 LET Z$=INKEY$ 
 4120 IF Z$<>"Z" AND Z$<>"Q" AND Z$<>CHR$ 118 THEN GOTO 4100
 4130 IF Z$="Q" THEN GOTO CAL
 4140 IF Z$="Z" THEN GOSUB 5000
 4150 LET PD=PD+P
 4160 GOTO 4010
 4999 REM [P][A][R][T][I][A][L]█[C][O][P][Y]
 5000 POKE VAL "17692",E*(A+NM)
 5010 IF USR HR THEN COPY
 5020 POKE VAL "17692",VAL "192"
 5030 RETURN
 7000 REM [E][X][I][T]
 7010 PRINT AT 11,15;"[E][N][D]",,,TAB 6;" GOTO CAL TO RESTART"
 7020 IF USR HR THEN RETURN
 7030 STOP
 8000 REM [F][-][S][A][V][E]
 8005 CLS
 8010 IF USR HR THEN RETURN
 8015 PRINT " SAVE  OR  LOAD ?"
 8020 LET Z$=INKEY$ 
 8025 IF Z$<>"S" AND Z$<>"L" THEN GOTO 8020
 8030 PRINT ,,"NAME?"
 8040 INPUT T$
 8045 REM [T][O]█[E][N][A][B][L][E]█[F][A][S][T]█[T][A][P][E][S][A][V][E]         [U][N][-][R][E][M]█[8][0][5][0]█[A][N][D]█[8][0][6][0][,]██         [D][E][L][E][T][E]█[8][0][5][5]█[A][N][D]█[8][0][6][5]███ 
 8050 REM  IF Z$="S" THEN IF USR HR THEN SAVE T$,V
 8055 IF Z$="S" THEN SAVE T$
 8060 REM  IF Z$="L" THEN IF USR HR THEN LOAD T$,V
 8065 IF T$="L" THEN LOAD T$
 8070 IF USR HR THEN CLS
 8080 IF USR HR THEN RUN 
 8090 GOSUB 9000
 8100 GOTO CAL
 8110 SAVE "198[7]"
 8120 GOTO 8070
 9000 REM [C][O][V][E][R]
 9020 IF USR HR THEN PRINT AT E*E,E*U;;;"[Y][E][A][R]-[A][T]-[A]-[G][L][A][N][C][E]",,,TAB E*A;,"BY [F]RED [N]ACHBAUR"
 9030 IF USR HR THEN PAUSE Y*Y
 9040 IF USR HR THEN LPRINT SD;O,"FF,81,81,81,81,81,81,FF,F0,90,90,90,90,90,90,F0"
 9050 RETURN

Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.

Tags

Archived Media Downloadable TS 1000 Calendar

People

Scroll to Top