2025-12-15 19:40:35 -08:00
|
|
|
import SDL
|
|
|
|
|
|
|
|
|
|
def SCREEN_WIDTH : Int32 := 1280
|
|
|
|
|
def SCREEN_HEIGHT : Int32 := 720
|
|
|
|
|
|
2026-07-08 22:21:03 -07:00
|
|
|
def isEscapeKeyDown : IO Bool := SDL.getKeyState SDL.SDL_SCANCODE_ESCAPE
|
2025-12-24 02:53:47 -08:00
|
|
|
|
2026-09-08 15:23:49 -07:00
|
|
|
-- SDL reports camera permission asynchronously (macOS shows a system prompt); the format and
|
|
|
|
|
-- frames are unavailable until the approved event arrives.
|
|
|
|
|
partial def waitForCameraPermission : IO Bool := do
|
|
|
|
|
let eventType ← SDL.pollEvent
|
|
|
|
|
if eventType == SDL.SDL_EVENT_CAMERA_DEVICE_APPROVED then
|
|
|
|
|
return true
|
|
|
|
|
if eventType == SDL.SDL_EVENT_CAMERA_DEVICE_DENIED || eventType == SDL.SDL_QUIT then
|
|
|
|
|
return false
|
|
|
|
|
if eventType == 0 then
|
|
|
|
|
IO.sleep 10
|
|
|
|
|
waitForCameraPermission
|
|
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
structure WebcamState where
|
|
|
|
|
window : SDL.SDLWindow
|
|
|
|
|
renderer : SDL.SDLRenderer
|
|
|
|
|
camera : SDL.SDLCamera
|
|
|
|
|
texture : Option SDL.SDLTexture
|
|
|
|
|
running : Bool
|
2025-12-24 02:53:47 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
partial def webcamLoop (stateRef: IO.Ref WebcamState): IO Unit := do
|
|
|
|
|
let state ← stateRef.get
|
2025-12-24 02:53:47 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
-- Check for quit event
|
|
|
|
|
let eventType ← SDL.pollEvent
|
2026-07-08 22:21:03 -07:00
|
|
|
if eventType == SDL.SDL_QUIT || (← isEscapeKeyDown) then
|
2025-12-26 23:15:55 -08:00
|
|
|
stateRef.modify fun s => { s with running := false }
|
|
|
|
|
return
|
2025-12-24 02:53:47 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
-- Try to acquire a camera frame (may return none if no frame ready)
|
|
|
|
|
let maybeFrame ← SDL.acquireCameraFrame state.camera
|
2025-12-25 18:01:01 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
match maybeFrame with
|
2025-12-25 19:44:20 -08:00
|
|
|
| none =>
|
2025-12-26 23:15:55 -08:00
|
|
|
-- No frame available yet, just continue
|
|
|
|
|
pure ()
|
|
|
|
|
| some cameraFrame =>
|
|
|
|
|
let w := cameraFrame.w.toUInt32
|
|
|
|
|
let h := cameraFrame.h.toUInt32
|
|
|
|
|
|
|
|
|
|
match state.texture with
|
|
|
|
|
| none =>
|
|
|
|
|
-- First frame: create the texture
|
|
|
|
|
let cameraTexture ← SDL.createTexture state.renderer cameraFrame.format SDL.SDL_TEXTUREACCESS_STREAMING w h
|
|
|
|
|
stateRef.modify fun s => { s with texture := some cameraTexture }
|
|
|
|
|
| some tx =>
|
2026-03-23 13:41:24 -07:00
|
|
|
-- Subsequent frames: update the texture directly from the camera frame
|
|
|
|
|
let _ ← SDL.updateTextureFromSurface tx cameraFrame
|
2025-12-26 23:15:55 -08:00
|
|
|
|
|
|
|
|
SDL.releaseCameraFrame state.camera cameraFrame
|
|
|
|
|
|
|
|
|
|
-- Clear the renderer
|
|
|
|
|
let _ ← SDL.setRenderDrawColorFloat state.renderer 0.4 0.6 1.0 SDL.SDL_ALPHA_OPAQUE_FLOAT
|
|
|
|
|
let _ ← SDL.renderClear state.renderer
|
|
|
|
|
|
|
|
|
|
-- Render the texture if we have one
|
|
|
|
|
let state ← stateRef.get
|
|
|
|
|
match state.texture with
|
|
|
|
|
| none => pure ()
|
2025-12-25 19:44:20 -08:00
|
|
|
| some tx =>
|
2025-12-26 23:15:55 -08:00
|
|
|
let _ ← SDL.renderTextureFullscreen state.renderer tx
|
|
|
|
|
pure ()
|
2025-12-25 19:44:20 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
-- Present the frame
|
|
|
|
|
SDL.renderPresent state.renderer
|
2025-12-25 19:44:20 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
-- Continue the loop if still running
|
|
|
|
|
let state ← stateRef.get
|
|
|
|
|
if state.running then
|
|
|
|
|
webcamLoop stateRef
|
2025-12-24 02:53:47 -08:00
|
|
|
|
2026-07-08 23:00:18 -07:00
|
|
|
def main : IO Unit := do
|
2025-12-17 03:10:58 -08:00
|
|
|
unless (← SDL.init (SDL.SDL_INIT_VIDEO ||| SDL.SDL_INIT_CAMERA)) == 1 do
|
2025-12-15 19:40:35 -08:00
|
|
|
IO.println "Failed to initialize SDL"
|
|
|
|
|
return
|
|
|
|
|
|
2025-12-16 00:27:37 -08:00
|
|
|
let (window, renderer) ← try
|
|
|
|
|
SDL.createWindowAndRenderer "WebcamTest" SCREEN_WIDTH SCREEN_HEIGHT SDL.SDL_WINDOW_SHOWN
|
2025-12-15 19:40:35 -08:00
|
|
|
catch sdlError =>
|
|
|
|
|
IO.println sdlError
|
|
|
|
|
SDL.quit
|
|
|
|
|
return
|
|
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
let cameraCount ← SDL.getCameras
|
2025-12-17 03:10:58 -08:00
|
|
|
IO.println s!"Camera count: {cameraCount}"
|
2025-12-15 19:40:35 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
if cameraCount.isEmpty then
|
|
|
|
|
IO.println "No cameras found!"
|
|
|
|
|
SDL.quit
|
|
|
|
|
return
|
2025-12-17 16:49:39 -08:00
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
let idx := cameraCount[0]!
|
|
|
|
|
let camera ← SDL.openCamera idx
|
|
|
|
|
|
2026-09-08 15:23:49 -07:00
|
|
|
IO.println "Waiting for camera permission..."
|
|
|
|
|
unless (← waitForCameraPermission) do
|
|
|
|
|
IO.println "Camera permission denied"
|
|
|
|
|
SDL.quit
|
|
|
|
|
return
|
|
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
let spec ← SDL.getCameraFormat camera
|
2025-12-18 03:15:45 -08:00
|
|
|
|
2025-12-23 23:37:22 -08:00
|
|
|
let msg :=
|
|
|
|
|
let width := spec.width
|
|
|
|
|
let height := spec.height
|
|
|
|
|
let n := spec.framerateNumerator
|
|
|
|
|
let d := spec.framerateDenominator
|
|
|
|
|
s!"Framerate: {n}/{d} FPS width: {width}, height: {height}"
|
|
|
|
|
IO.println msg
|
|
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
let initialState : WebcamState := {
|
|
|
|
|
window := window
|
|
|
|
|
renderer := renderer
|
|
|
|
|
camera := camera
|
|
|
|
|
texture := none
|
|
|
|
|
running := true
|
2025-12-15 19:40:35 -08:00
|
|
|
}
|
|
|
|
|
|
2025-12-26 23:15:55 -08:00
|
|
|
let stateRef ← IO.mkRef initialState
|
|
|
|
|
IO.println "Starting webcam loop..."
|
|
|
|
|
webcamLoop stateRef
|
2025-12-15 19:40:35 -08:00
|
|
|
SDL.quit
|