langs a-z
This commit is contained in:
Ingy döt Net
parent
db842d013d
commit
d066446780
11389 changed files with 98361 additions and 1020 deletions
203
Task/Honeycombs/PureBasic/honeycombs.purebasic
Normal file
203
Task/Honeycombs/PureBasic/honeycombs.purebasic
Normal file
|
|
@ -0,0 +1,203 @@
|
|||
Structure hexGadget
|
||||
text.s
|
||||
Status.i ;nonselected = 0, selected = 1
|
||||
center.POINT ;location of hex's center
|
||||
List shape.POINT()
|
||||
EndStructure
|
||||
|
||||
Structure honeycomb
|
||||
gadgetID.i
|
||||
margins.POINT
|
||||
unusedLetters.s
|
||||
chosen.s
|
||||
maxLength.i
|
||||
Array hexGadgets.hexGadget(0)
|
||||
textY.i
|
||||
EndStructure
|
||||
|
||||
Prototype hexEvent_prt(*h.honeycomb, hexID)
|
||||
|
||||
Procedure inpoly(*p.POINT, List poly.POINT())
|
||||
;returns 1 if point is inside the polygon defined by poly(), otherwise returns 0
|
||||
Protected new.POINT, old.POINT, lp.POINT, rp.POINT, i, inside, *poly
|
||||
If ListSize(poly()) < 3: ProcedureReturn 0: EndIf
|
||||
LastElement(poly()): old = poly()
|
||||
ForEach poly()
|
||||
;find leftmost endpoint 'lp' and the rightmost endpoint 'rp' based on x value
|
||||
If poly()\x > old\x
|
||||
lp = old
|
||||
rp = poly()
|
||||
Else
|
||||
lp = poly()
|
||||
rp = old
|
||||
EndIf
|
||||
If lp\x < *p\x And *p\x <= rp\x And (*p\y - lp\y) * (rp\x - lp\x) < (rp\y - lp\y) * (*p\x - lp\x)
|
||||
inside = ~inside
|
||||
EndIf
|
||||
old = poly()
|
||||
Next
|
||||
ProcedureReturn inside & 1
|
||||
EndProcedure
|
||||
|
||||
;draw a hex Gadget by number
|
||||
Procedure drawhex(*h.honeycomb, hexID)
|
||||
With *h\hexGadgets(hexID)
|
||||
Protected p.POINT
|
||||
If LastElement(\shape())
|
||||
p = \shape()
|
||||
EndIf
|
||||
ForEach \shape()
|
||||
LineXY(p\x, p\y, \shape()\x, \shape()\y, RGB(0, 0, 0)) ;black
|
||||
p = \shape()
|
||||
Next
|
||||
DrawingMode(#PB_2DDrawing_Transparent)
|
||||
DrawingFont(FontID(0))
|
||||
If \Status
|
||||
FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, 0, $FF)) ;magenta
|
||||
DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB(0, 0, 1)) ;black, almost
|
||||
Else
|
||||
FillArea(\center\x + 1, \center\y + 1, RGB(0, 0, 0), RGB($FF, $FF, 0)) ;yellow
|
||||
DrawText(\center\x - TextWidth(\text) / 2, \center\y - TextHeight(\text) / 2, \text, RGB($FF, 0, 0)) ;red
|
||||
EndIf
|
||||
EndWith
|
||||
EndProcedure
|
||||
|
||||
Procedure selectHex(*h.honeycomb, hexID)
|
||||
If Not *h\hexGadgets(hexID)\Status
|
||||
*h\chosen + *h\hexGadgets(hexID)\text
|
||||
*h\hexGadgets(hexID)\Status = 1
|
||||
StartDrawing(CanvasOutput(*h\gadgetID))
|
||||
drawhex(*h, hexID)
|
||||
DrawingMode(#PB_2DDrawing_Default)
|
||||
DrawingFont(#PB_Default)
|
||||
DrawText(0, *h\textY, "Chosen: " + *h\chosen)
|
||||
DrawText(0, *h\textY + 20, "The user chose letter " + *h\hexGadgets(hexID)\text + ". ")
|
||||
StopDrawing()
|
||||
ProcedureReturn 1
|
||||
EndIf
|
||||
EndProcedure
|
||||
|
||||
Procedure hexKey(*h.honeycomb, hexID)
|
||||
If UCase(Chr(GetGadgetAttribute(*h\gadgetID, #PB_Canvas_Input))) = *h\hexGadgets(hexID)\text
|
||||
ProcedureReturn selectHex(*h, hexID)
|
||||
EndIf
|
||||
EndProcedure
|
||||
|
||||
Procedure hexMouse(*h.honeycomb, hexID)
|
||||
Protected mPos.POINT
|
||||
mPos\x = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseX)
|
||||
mPos\y = GetGadgetAttribute(*h\gadgetID, #PB_Canvas_MouseY)
|
||||
If inpoly(mPos,*h\hexGadgets(hexID)\shape())
|
||||
ProcedureReturn selectHex(*h, hexID)
|
||||
EndIf
|
||||
EndProcedure
|
||||
|
||||
Procedure honeycombEvents(*h.honeycomb)
|
||||
If Len(*h\chosen) >= *h\maxLength: ProcedureReturn: EndIf
|
||||
|
||||
Protected event = EventType(), *eventFunction.hexEvent_prt
|
||||
Select event
|
||||
Case #PB_EventType_Input
|
||||
*eventFunction = @hexKey()
|
||||
Case #PB_EventType_LeftButtonUp
|
||||
*eventFunction = @hexMouse()
|
||||
Case #PB_EventType_LostFocus
|
||||
SetActiveGadget(*h\gadgetID)
|
||||
EndSelect
|
||||
|
||||
If *eventFunction
|
||||
For hexID = 0 To ArraySize(*h\hexGadgets())
|
||||
If *eventFunction(*h, hexID)
|
||||
Break ;event successfully handled
|
||||
EndIf
|
||||
Next
|
||||
EndIf
|
||||
EndProcedure
|
||||
|
||||
Procedure createHexGadget(*h.honeycomb, hexID, x, y, dx, dy)
|
||||
With *h\hexGadgets(hexID)
|
||||
If *h\unusedLetters
|
||||
Protected letterNum = Random(Len(*h\unusedLetters) - 1) + 1
|
||||
\text = Mid(*h\unusedLetters, letterNum, 1)
|
||||
*h\unusedLetters = ReplaceString(*h\unusedLetters, \text, "")
|
||||
EndIf
|
||||
\center\x = x: \center\y = y
|
||||
AddElement(\shape()): \shape()\x = x - dx: \shape()\y = y
|
||||
AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y + dy
|
||||
AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y + dy
|
||||
AddElement(\shape()): \shape()\x = x + dx: \shape()\y = y
|
||||
AddElement(\shape()): \shape()\x = x + dx / 2: \shape()\y = y - dy
|
||||
AddElement(\shape()): \shape()\x = x - dx / 2: \shape()\y = y - dy
|
||||
EndWith
|
||||
EndProcedure
|
||||
|
||||
Procedure initHoneycomb(*h.honeycomb, posX, posY, dx = 30, dy = 25, marginX = 10, marginY = 5)
|
||||
Protected i, sx, sy, hCols = 5, hRows = 4, hexGadgetCount = hCols * hRows - 1
|
||||
If Not *h: ProcedureReturn 0: EndIf
|
||||
|
||||
*h\unusedLetters.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
*h\chosen = ""
|
||||
*h\maxLength = 20
|
||||
|
||||
Dim *h\hexGadgets(hexGadgetCount)
|
||||
;calculate size width, height and create honeycomb with margins
|
||||
sx = Round(dx * (0.5 + hCols * 1.5), #PB_Round_Nearest) + 1 + 2 * marginX
|
||||
sy = dy * (2 * hRows + 1) + 1 + 2 * marginY + 2 * 20 ;includes room for hex, margins, and text
|
||||
*h\textY = sy - 2 * 20
|
||||
|
||||
;create hexes
|
||||
Protected hexID, column, row, x, y, baseX, baseY, majorOffsetY = dy
|
||||
baseX = dx + marginX
|
||||
For column = 0 To hCols - 1
|
||||
baseY = dy + marginY
|
||||
majorOffsetY ! dy
|
||||
For row = 0 To hRows - 1
|
||||
x = baseX
|
||||
y = baseY + majorOffsetY
|
||||
createHexGadget(*h, hexID, x, y, dx, dy)
|
||||
baseY + dy * 2
|
||||
hexID + 1
|
||||
Next
|
||||
baseX + dx * 1.5
|
||||
Next
|
||||
|
||||
;draw honeycomb
|
||||
*h\gadgetID = CanvasGadget(#PB_Any, posX, posY, sx, sy, #PB_Canvas_Keyboard | #PB_Canvas_ClipMouse)
|
||||
If *h\gadgetID = 0: ProcedureReturn 0: EndIf ;failed to created honeycomb
|
||||
|
||||
LoadFont(0, "Arial", 24, #PB_Font_Bold)
|
||||
StartDrawing(CanvasOutput(*h\gadgetID))
|
||||
For i = 0 To ArraySize(*h\hexGadgets())
|
||||
drawhex(*h, i)
|
||||
Next
|
||||
Box(0, *h\textY, sx, 40, RGB(0, 0, 0)) ;draw black text box
|
||||
StopDrawing()
|
||||
ProcedureReturn 1
|
||||
EndProcedure
|
||||
|
||||
If OpenWindow(0, 0, 0, 400, 400, "PureBasic - Honeycombs", #PB_Window_SystemMenu)
|
||||
Define honeycomb.honeycomb, quit
|
||||
If Not initHoneycomb(honeycomb, 0, 0): End: EndIf
|
||||
ResizeWindow(0, #PB_Ignore, #PB_Ignore, GadgetWidth(honeycomb\gadgetID), GadgetHeight(honeycomb\gadgetID))
|
||||
SetActiveGadget(honeycomb\gadgetID)
|
||||
|
||||
Repeat
|
||||
event = WaitWindowEvent()
|
||||
|
||||
Select event
|
||||
Case #PB_Event_Gadget
|
||||
If EventGadget() = honeycomb\gadgetID
|
||||
honeycombEvents(honeycomb)
|
||||
If Len(honeycomb\chosen) = honeycomb\maxLength
|
||||
MessageRequester("Exit", "You chose: " + honeycomb\chosen + ".")
|
||||
quit = 1
|
||||
EndIf
|
||||
EndIf
|
||||
Case #PB_Event_CloseWindow
|
||||
quit = 1
|
||||
EndSelect
|
||||
|
||||
Until quit = 1
|
||||
FreeGadget(honeycomb\gadgetID)
|
||||
CloseWindow(0)
|
||||
EndIf
|
||||
42
Task/Honeycombs/XPL0/honeycombs.xpl0
Normal file
42
Task/Honeycombs/XPL0/honeycombs.xpl0
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
include c:\cxpl\stdlib; \(color definitions, etc.)
|
||||
|
||||
proc DrawHexagon(X0, Y0, Side, Color); \Draw a filled hexagon centered at X0,Y0
|
||||
int X0, Y0, Side, Color;
|
||||
int X, Y;
|
||||
for Y:= -Side*19/22 to +Side*19/22 do \19/22 aprox = sqrt(3.0)/2.0
|
||||
for X:= -Side to +Side do
|
||||
if abs(X) + abs(Y)*23/38 <= Side then \23/38 aprox = 1.0/sqrt(3.0)
|
||||
Point(X+X0, Y+Y0, Color);
|
||||
|
||||
def Cols=5, Rows=4, X0=23, Y0=20; \matrix shape, offset on screen
|
||||
int C, R, X, Y, Letter, Counter, SaveX(26), SaveY(26);
|
||||
[SetVid($101); \set video to 640x480x8 graphics
|
||||
for Letter:= 0 to 26-1 do SaveX(Letter):= 0;
|
||||
Attrib(LMagenta<<8); \light magenta letter background
|
||||
for R:= 0 to Rows-1 do
|
||||
for C:= 0 to Cols-1 do
|
||||
[X:= C*35 + X0; Y:= R*40 + (C&1)*20 + Y0;
|
||||
DrawHexagon(X, Y, 22, LMagenta);
|
||||
repeat Letter:= Ran(26) until SaveX(Letter) = 0;
|
||||
Move(X-4, Y-7); ChOut(6, Letter+^A);
|
||||
SaveX(Letter):= X; SaveY(Letter):= Y; \save coordinates for letter
|
||||
];
|
||||
Counter:= 0;
|
||||
repeat Letter:= ChIn(1); \get letter from keyboard
|
||||
if Letter>=^a & Letter<=^z then Letter:= Letter-$20; \make uppercase
|
||||
if Letter>=^A & Letter<=^Z then
|
||||
if SaveX(Letter-^A) # 0 then \letter is available
|
||||
[X:= SaveX(Letter-^A); Y:= SaveY(Letter-^A);
|
||||
DrawHexagon(X, Y, 22, Yellow); \change color
|
||||
Move(X-4, Y-7);
|
||||
Attrib(Yellow<<8); ChOut(6, Letter);
|
||||
Move(Counter*8+8, Rows*40+30); \show record of chosen letters
|
||||
Attrib(Yellow); ChOut(6, Letter);
|
||||
Counter:= Counter+1;
|
||||
SaveX(Letter-^A):= 0; \letter is no longer available
|
||||
]
|
||||
else ChOut(0, Bel) \letter is not available
|
||||
else ChOut(0, Bel); \not a letter (A..Z)
|
||||
until Counter >= Cols*Rows;
|
||||
SetVid($03); \restore normal text display
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue