1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107

open Tsdl.Sdl
open Tsdl_mixer.Mixer

let error s = Format.eprintf "%s@." s ; exit 1

let quick_start title x y w h =
  let win =
    match create_window title ~x ~y ~w ~h Window.shown with
    | Ok w ->
        w
    | _ ->
        error "can't create window"
  in
  let open Renderer in
  let rend =
    match
      create_renderer ~index:(-1) ~flags:(accelerated + presentvsync) win
    with
    | Ok r ->
        r
    | _ ->
        error "can't create renderer"
  in
  Obj.magic rend

module M : Common.Backend.S = struct
  type t = renderer

  type audio_file = Tsdl_mixer.Mixer.chunk

  let begin_display _ = ()

  let error = error

  let display ctx = render_present ctx

  let clear ctx =
    match render_fill_rect ctx None with Ok _ -> () | _ -> error "can't clear"

  let draw_point ctx (x, y) =
    match render_draw_point ctx x y with
    | Ok _ ->
        ()
    | _ ->
        error "can't draw point"

  let draw_line ctx (x1, y1) (x2, y2) =
    match render_draw_line ctx x1 y1 x2 y2 with
    | Ok _ ->
        ()
    | _ ->
        error "can't draw line"

  let draw_rect ctx (x, y) (w, h) =
    let r = Rect.create ~x ~y ~w ~h in
    match render_draw_rect ctx (Some r) with
    | Ok _ ->
        ()
    | _ ->
        error "can't draw rect"

  let init_audio () =
    match open_audio 44100 default_format default_channels 2048 with
    | Ok _ ->
        ()
    | _ ->
        error "can not init sound"

  let fill_rect ctx (x, y) (w, h) =
    let r = Rect.create ~x ~y ~w ~h in
    match render_fill_rect ctx (Some r) with
    | Ok _ ->
        ()
    | _ ->
        error "can't fill rect"

  let load_audio_file path =
    match load_wav path with Ok s -> s | _ -> error "can't load audio file"

  let play_audio_loop audio =
    match play_channel (-1) audio (-1) with
    | Ok _ ->
        ()
    | _ ->
        error "can't play audio loop"

  let play_audio_once audio =
    match play_channel (-1) audio 0 with
    | Ok _ ->
        ()
    | _ ->
        error "can't play audio once"

  let set_rgb_color ctx (r, g, b) =
    match set_render_draw_color ctx r g b 255 with
    | Ok _ ->
        ()
    | _ ->
        error "can't set rgb color"

  let set_rgba_color ctx (r, g, b, a) =
    match set_render_draw_color ctx r g b a with
    | Ok _ ->
        ()
    | _ ->
        error "can't set rgb color"
end