To run online, click here: RUN ONLINE
Code:
' PROGRAM Fair Shares
' (c) ZarSoft 2022 Pascalated BASIC
' (c) ZarSoft 2023 Pascalated Boriel ZX BASIC
' Written by Ze Oliveira
' Pascalated Sinclair BASIC (c) 1987 by ZarSoft
' Pascalated BASIC Converter (c) 2021 by Zarsoft
' Pascalated Boriel (c) 2023 by ZarSoft
' ZX BASIC Compiler (c) 2008 by Boriel
#include <input.bas> ' number = VAL INPUT(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas> ' ATTR function
'--- Pascalated Boriel ---
#define PROGRAM REM
#define BEGIN REM
'#define CONST CONST
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define CHAR STRING
'#define STRING STRING
#define BOOLEAN UBYTE
#define TYPE AS
'#define WHILE WHILE
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
PROGRAM FairShares
' CONSTant declarations
CONST black = 0
CONST blue = 1
CONST red = 2
CONST magenta = 3
CONST green = 4
CONST cyan = 5
CONST white = 7
CONST MinMoves = 7
CONST LIN = 16 ' line of buckets
' VARiables
VAR Columns(3) TYPE INTEGER ' Columns of buckets
VAR Capacity(3) TYPE INTEGER ' buckets size (capacity)
VAR Quantity(3) TYPE INTEGER ' milk Quantity on bucket
VAR MoveFrom TYPE INTEGER ' move from to
VAR MoveTo TYPE INTEGER ' move from to
VAR Abort TYPE BOOLEAN
VAR TheEnd TYPE BOOLEAN
VAR Nmoves TYPE INTEGER
PROCEDURE CheckEnd
LET TheEnd = TRUE
IF Abort THEN LET TheEnd = FALSE
IF (Nmoves > MinMoves+1)
LET TheEnd = FALSE
PRINT AT 4,9;INK magenta;"TOO MUCH MOVES!"
PRINT AT 5,9;INK magenta;" Try again. "
: FOR i=11 TO -11 STEP -1: BEEP .01,i: BEEP .01,ABS(i): NEXT i
PRINT AT 23,0;PAPER green;INK 0;" Press any key to continue";TAB 32;
PAUSE 10
PAUSE 10
PAUSE 0
BEEP .1,5
ENDIF
END PROCEDURE
PROCEDURE finalization
PRINT AT 4,0; INK magenta;" ===-- CONGRATULATIONS! --=== "
: FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
PRINT AT 23,0;PAPER green;INK 0;TAB 5;"Press any key to exit";TAB 32;
PAUSE 5
PAUSE 5
PAUSE 0
BEEP .1,5
END PROCEDURE
PROCEDURE MoveMilk ' ( MoveFrom, MoveTo )
VAR moved TYPE BOOLEAN
LET moved = FALSE
WHILE Quantity(MoveFrom)>0 AND Quantity(MoveTo)<Capacity(MoveTo)
LET moved = TRUE
REM get
PRINT AT LIN-Quantity(MoveFrom),Columns(MoveFrom);" ";
LET Quantity(MoveFrom) = Quantity(MoveFrom)-1
REM put
LET Quantity(MoveTo) = Quantity(MoveTo)+1
PRINT AT LIN-Quantity(MoveTo),Columns(MoveTo);"\::\::\::\::\::\::";
END WHILE
IF moved BEGIN
LET Nmoves = Nmoves+1
PRINT AT 2,0;INK 0;"Moves: ";Nmoves
ENDIF
END PROCEDURE
PROCEDURE InputMove ' ( MoveFrom, MoveTo )
' VAR
REM BEGIN
PRINT AT LIN+2,1;PAPER green;INK black;"MOVE FROM... ";
REPEAT
PAUSE 0
LET k$ = INKEY$
UNTIL k$ >= "0" AND k$ <= "9"
BEEP .1,5
LET MoveFrom = VAL (k$)
LET k$ = "9"
IF MoveFrom=0 THEN LET Abort = TRUE: LET k$="0"
PRINT AT LIN+2,1;PAPER green;INK black;"MOVE FROM ";MoveFrom;" TO... ";
WHILE NOT(Abort) AND NOT (k$ >= "0" AND k$ <= "3")
PAUSE 0
LET k$ = INKEY$
END WHILE
BEEP .1,5
LET MoveTo = VAL k$
IF MoveTo=0 THEN LET Abort = TRUE
IF Abort THEN LET MoveFrom = 1: LET MoveTo = 1
PRINT AT LIN+2,1;PAPER green;INK black;" ";TAB 31;
END PROCEDURE
PROCEDURE InitBackground
REM background
BORDER 4 : PAPER 4 : INK 0 : CLS
BORDER 5 : PAPER 5
FOR n=0 TO LIN
PRINT ;" ";TAB 32;
NEXT n
REM buckets
PAPER cyan: INK blue
FOR b=1 TO 3
PRINT AT LIN-0,Columns(b)-1;"\ :\::\::\::\::\::\::\: "
FOR i = 1 TO Capacity(b)
PRINT AT LIN-i,Columns(b)-1;"\ : \: "
NEXT i
NEXT b
REM milk
PAPER cyan: INK white
FOR i = 1 TO 8
PRINT AT LIN-i,Columns(1);"\::\::\::\::\::\::"
NEXT i
PRINT AT 0,0;PAPER white;INK red;TAB 10;"FAIR SHARES";TAB 32;
PRINT AT 2,19;INK 0;"Minimum: ";MinMoves
PRINT AT 23,0;PAPER green;INK black;"123 - Select bucket 0 - Abort";
END PROCEDURE
PROCEDURE InitVars
LET TheEnd = FALSE
LET Abort = FALSE
' DIM Quantity(3): REM milk quantity on bucket
LET Quantity(1) = 8
LET Quantity(2) = 0
LET Quantity(3) = 0
LET Nmoves = 0
END PROCEDURE
PROCEDURE Introduction
BORDER black: PAPER black: INK green: CLS
PRINT AT 0,10;INK 4;"FAIR SHARES"
INK white
PRINT
PRINT
PRINT "You have 3 buckets of milk."
PRINT
PRINT "The buckets hold 8 liter","5 liter, and 3 liter."
PRINT
PRINT "The 8 liter bucket is full","the others empty."
PRINT
PRINT "You must divide the milk into 2 equal portions, by pouring from one bucket to another."
INK blue
PRINT
PRINT
PRINT "This program was inspired by the book: Computer Puzzles - For Spectrum and ZX81 (Ian Stewart and Robin Jones), 1982."
PRINT AT 23,8;INK blue;"Press any key";
PAUSE 0
BEEP .1,5
END PROCEDURE
PROCEDURE InitProgram
'VAR Columns(3) TYPE INTEGER ' REM columns of buckets
LET Columns(1) = 4
LET Columns(2) = 13
LET Columns(3) = 22
'VAR Capacity(3): REM buckets size (capacity)
LET Capacity(1) = 8
LET Capacity(2) = 5
LET Capacity(3) = 3
END PROCEDURE
PROCEDURE Main
InitProgram
REPEAT
Introduction
InitVars
InitBackground
REPEAT
InputMove ' (MoveFrom,t)
IF MoveFrom<>MoveTo THEN MoveMilk ' (MoveFrom,t)
UNTIL ( Quantity(1) = 4 AND Quantity(2) = 4 ) OR Abort
CheckEnd
UNTIL TheEnd
finalization
END PROCEDURE
PROGRAM FairShares
PRINT
PRINT "Pascalated Boriel ZX BASIC demo"
PAUSE 1*50
Main
END PROGRAM